gprolog-1.4.5/0000755000175000017500000000000013021361131011311 5ustar spaspagprolog-1.4.5/COPYING0000644000175000017500000006470713021324543012370 0ustar spaspa GNU PROLOG LICENSE CONDITIONS GNU Prolog is free software. Since version 1.4.0, GNU Prolog distributed under a dual license: LGPL or GPL. So, you can redistribute it and/or modify it under the terms of either: * the GNU Lesser General Public License (LGPL) as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. or * the GNU General Public License (GPL) as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. or both in parallel (as here). GNU Prolog 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 copies of the GNU General Public License and the GNU Lesser General Public License along with this program. If not, see http://www.gnu.org/licenses/. Remark: versions of GNU Prolog prior to 1.4.0 were entirely released under the GNU General Public License (GPL). The rest of this file contains LGPL v3 and GPL v2 --------------------------------------------------------------------------- GNU LESSER GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. This version of the GNU Lesser General Public License incorporates the terms and conditions of version 3 of the GNU General Public License, supplemented by the additional permissions listed below. 0. Additional Definitions. As used herein, "this License" refers to version 3 of the GNU Lesser General Public License, and the "GNU GPL" refers to version 3 of the GNU General Public License. "The Library" refers to a covered work governed by this License, other than an Application or a Combined Work as defined below. An "Application" is any work that makes use of an interface provided by the Library, but which is not otherwise based on the Library. Defining a subclass of a class defined by the Library is deemed a mode of using an interface provided by the Library. A "Combined Work" is a work produced by combining or linking an Application with the Library. The particular version of the Library with which the Combined Work was made is also called the "Linked Version". The "Minimal Corresponding Source" for a Combined Work means the Corresponding Source for the Combined Work, excluding any source code for portions of the Combined Work that, considered in isolation, are based on the Application, and not on the Linked Version. The "Corresponding Application Code" for a Combined Work means the object code and/or source code for the Application, including any data and utility programs needed for reproducing the Combined Work from the Application, but excluding the System Libraries of the Combined Work. 1. Exception to Section 3 of the GNU GPL. You may convey a covered work under sections 3 and 4 of this License without being bound by section 3 of the GNU GPL. 2. Conveying Modified Versions. If you modify a copy of the Library, and, in your modifications, a facility refers to a function or data to be supplied by an Application that uses the facility (other than as an argument passed when the facility is invoked), then you may convey a copy of the modified version: a) under this License, provided that you make a good faith effort to ensure that, in the event an Application does not supply the function or data, the facility still operates, and performs whatever part of its purpose remains meaningful, or b) under the GNU GPL, with none of the additional permissions of this License applicable to that copy. 3. Object Code Incorporating Material from Library Header Files. The object code form of an Application may incorporate material from a header file that is part of the Library. You may convey such object code under terms of your choice, provided that, if the incorporated material is not limited to numerical parameters, data structure layouts and accessors, or small macros, inline functions and templates (ten or fewer lines in length), you do both of the following: a) Give prominent notice with each copy of the object code that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the object code with a copy of the GNU GPL and this license document. 4. Combined Works. You may convey a Combined Work under terms of your choice that, taken together, effectively do not restrict modification of the portions of the Library contained in the Combined Work and reverse engineering for debugging such modifications, if you also do each of the following: a) Give prominent notice with each copy of the Combined Work that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the Combined Work with a copy of the GNU GPL and this license document. c) For a Combined Work that displays copyright notices during execution, include the copyright notice for the Library among these notices, as well as a reference directing the user to the copies of the GNU GPL and this license document. d) Do one of the following: 0) Convey the Minimal Corresponding Source under the terms of this License, and the Corresponding Application Code in a form suitable for, and under terms that permit, the user to recombine or relink the Application with a modified version of the Linked Version to produce a modified Combined Work, in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source. 1) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (a) uses at run time a copy of the Library already present on the user's computer system, and (b) will operate properly with a modified version of the Library that is interface-compatible with the Linked Version. e) Provide Installation Information, but only if you would otherwise be required to provide such information under section 6 of the GNU GPL, and only to the extent that such information is necessary to install and execute a modified version of the Combined Work produced by recombining or relinking the Application with a modified version of the Linked Version. (If you use option 4d0, the Installation Information must accompany the Minimal Corresponding Source and Corresponding Application Code. If you use option 4d1, you must provide the Installation Information in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source.) 5. Combined Libraries. You may place library facilities that are a work based on the Library side by side in a single library together with other library facilities that are not Applications and are not covered by this License, and convey such a combined library under terms of your choice, if you do both of the following: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities, conveyed under the terms of this License. b) Give prominent notice with the combined library that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 6. Revised Versions of the GNU Lesser General Public License. The Free Software Foundation may publish revised and/or new versions of the GNU Lesser 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 Library as you received it specifies that a certain numbered version of the GNU Lesser General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that published version or of any later version published by the Free Software Foundation. If the Library as you received it does not specify a version number of the GNU Lesser General Public License, you may choose any version of the GNU Lesser General Public License ever published by the Free Software Foundation. If the Library as you received it specifies that a proxy can decide whether future versions of the GNU Lesser General Public License shall apply, that proxy's public statement of acceptance of any version is permanent authorization for you to choose that version for the Library. --------------------------------------------------------------------------- GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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 Lesser 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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 Lesser General Public License instead of this License. gprolog-1.4.5/ChangeLog0000644000175000017500000010233213021324543013072 0ustar spaspaFri Apr 3 10:01:02 CEST 2015 * fix a bug in findall/4 Tue Feb 17 11:39:11 CET 2015 * fix a bug in select/5 under Windows Fri Jan 16 19:25:51 CET 2015 * fix a bug in the compiler Thu Dec 18 08:59:45 CET 2014 * fix a bug in read/1 * fix large address awarenes under cygwin32 (configure.in) Thu Dec 11 17:18:09 CET 2014 * improve memory limitation of acyclic_term/1 Tue Dec 9 10:40:18 CET 2014 * improve term output (write/1 and friends) Fri Dec 5 02:55:30 CET 2014 * improve error handling for options (e.g. in write_term/3) Thu Dec 4 15:47:06 CET 2014 * fix bug with cut in the if-part of if-then(-else) * fix port to x86_64/OpenBSD (machine kindly provided by Duncan Patton a Campbell) Wed Dec 3 17:56:54 CET 2014 * fix a bug with Apple/Yosemite gcc = LLVM version 6.0 (clang-600.0.56) on x86_64 Fri Aug 22 15:10:18 CEST 2014 * allow to define more atoms with MAX_ATOM env var on 64 bits machines Wed Aug 13 11:25:18 CEST 2014 * fix a bug in bagof/3 when used as findall/3 Fri Jul 11 17:27:36 CEST 2014 * port to sparc64/OpenBSD (machine kindly provided by Duncan Patton a Campbell) Tue May 6 10:43:33 CEST 2014 * add built-in predicate findall/4 Thu Mar 6 16:19:36 CET 2014 * fix a bug with linedit when environment variable LINEDIT=no Wed Feb 5 15:16:37 CET 2014 * fix bugs in the FD solver Fri Nov 22 19:47:45 CET 2013 * set socket option SO_REUSEADDR at socket creation Thu Nov 21 16:29:57 CET 2013 * support for alternate Prolog file extension .prolog Mon Nov 18 18:32:44 CET 2013 * fix a bug in atoms for 1-char atom '\0' (now acts as the empty atom) Tue Nov 12 10:17:10 CET 2013 * fix problems with Apple/Mavericks gcc = LLVM version 5.0 (clang-500.2.79) on x86_64 * remove clang warnings (uninitialized variables) * fix bugs in the lexer of the form 0bop 2 when bop is an infix op Tue Oct 1 09:40:31 CEST 2013 * fix terminal ANSI sequence handling in linedit Wed Sep 18 09:25:06 CEST 2013 * increase internal compiler data sizes Thu Jul 4 13:17:07 CEST 2013 * fix bug in gprolog.h (invalid 64 bits PL_MAX_INTEGER) Fri Apr 12 17:17:50 CEST 2013 * add Prolog flags c_cc_version_data * fix a regression bug in linedit * fix a little bug in the debugger * add subtract/3 built-in predicate Wed Mar 27 16:35:02 CET 2013 * add new C foreign interface functions converting term to/from C strings Tue Mar 26 10:23:05 CET 2013 * modify top-level banner to show 32/64 bits, compile date, C compiler name * modify Linedit: fix Prolog prompt when Linedit is not activated * modify linedit: accept gui=silent in env var LINEDIT (does not warn if the windows gui DLL is not found) * fixes for Windows 8 (i686 and x86_64) with MSVS 2012, mingw64 gcc > 4.5.3 * add Prolog flags address_bits, compiled_at, c_cc, c_cflags, c_ldflags Thu Mar 14 12:46:35 CET 2013 * fix a bug in the FD solver (option backtracks in fd_labeling) * improve the FD solver (better propagation for reified constraints at labeling) * improve the FD solver (add labeling option: value_method(bisect)) Mon Mar 11 15:42:31 CET 2013 * improve the FD solver (avoid some cases of C stack overflow, improved fd_domain/3) * fix another bug in the FD solver (regression bug in 1.4.2) * add PlULong to gprolog.h and PlThrow(ball) to C foreign interface Mon Feb 25 13:57:51 CET 2013 * fix a bug in the FD solver (regression bug in 1.4.2) Wed Nov 28 17:04:46 CET 2012 * fix a bug in the compiler for byte-code with op/3 directive Thu Nov 22 16:20:23 CET 2012 * fix a bug in the debugger * modify decompose_file_name/4 (fix problems under windows) * add built-in is_absolute_file_name/1 and is_relative_file_name/1 * modify the compiler include/1 directive handling (if the file to include is not found, search in directories of parent includers) Thu Nov 15 16:15:50 CET 2012 * modify atom table management (its size can be defined via env. var MAX_ATOM) * fix a bug with soft-call inside a meta-call * implement term_hash/2 and term_hash/4. Backward incompatibility: new_atom/3 and and atom_hash/2 no longer exists. * fix some little bugs with 64 bits (e.g. stream id) Tue Oct 30 16:27:21 CET 2012 * modify the FD solver to handle very long computations Mon Sep 24 15:03:11 CEST 2012 * fix a bug in the compiler (unification with fresh vars in the body) * fix a bug with *-> containing ! in the test part (! was not local to the test) * fix a bug to configure with sigaction on old Linux kernels * fix some problems/bugs on 64 bits machine Fri Jun 15 13:34:45 CEST 2012 * improve signal handling Thu May 31 15:36:46 CEST 2012 * add an option --wam-comment to gplc and pl2wam * fix multifile directive (works now with an empty predicate as required by ISO) * fix absolute_file_name to expand ~ using HOMEDRIVE and HOMEPATH under windows if HOME is not defined Tue May 15 11:56:00 CEST 2012 * improve listing/0-1 output Fri May 11 18:09:19 CEST 2012 * add soft cut control construct and its associated operator *-> Thu May 3 16:42:00 CEST 2012 * improve the top-level results in case of cyclic terms Mon Apr 30 17:52:46 CEST 2012 * fix arithmetic evaluable functor ^/2 to work with floats * increase maximum number of variables in a term Thu Apr 26 11:29:44 CEST 2012 * add write_term option variable_names * add built-in predicates between/3 and succ/2 * fix bug in the DCG expander * fix bug in member/2 * recognize escape sequence \s (space) and \e (escape) if strict_iso is off * add error detection in length/2 if given length is negative Tue Mar 13 10:24:24 CET 2012 * add built-in predicates maplist/2-9 Mon Feb 20 19:12:04 CET 2012 * fix a regression bug in the FD solver about sparse domains Thu Feb 16 19:49:02 CET 2012 * increase size of FD internal stacks and fix memory leak Tue Jan 10 18:23:09 CET 2012 * port to x86_64/Darwin (Mac OS X) - many thanks to Ozaki Kiichi * fix a bug in x86_64 with --disable-regs * fix a bug when consulting a file under Win XP/Vista 32 bits * fix a bug when consulting a file using '$VAR'(N) or '$VARNAME'(A) * fix a bug in new_atom/1-2 which returned duplicates * fix a bug in write/1 when an empty atom is passed * improve portray_clause (numbervars and space before final dot) Fri Jun 10 15:59:42 CEST 2011 * GNU Prolog is now licensed under a dual license LGPL or GPL * port to x86_64/MinGW64 - many thanks to Jasper Taylor (see src/WINDOWS64) * port to x86_64/MSVC (see src/WINDOWS64) * add a configure option to control Windows HtmlHelp --disable-htmlhelp or --enable-htmlhelp[=static/dynamic] * improve a lot (and fix some bugs in) the Windows GUI Console * change location of gprologvars.bat under Windows (in install directory) * increase default stack sizes (32Mb for heap, 16Mb for others) * change the default setting for flag strict_iso: it is on now * add control constructs to the predicate table * modify predicate_property/2 (built_in_fd ==> built_in, add control_construct) only accepts a Head (a callable) (no longer a predicate indicator) * fix a bug in the compiler (bad unification with singleton variable) * fix a bug with strict_iso flag (was not passed to consult) * add shebang support using #!/usr/bin/gprolog --consult-file * modify the mangling scheme for future module support (see hexgplc) * fix write_term default options (now numbervars(false) and namevars(false)) * fix read/1: tab and newlines are not accepted inside single/back/double quoted tokens * add additional errors to compare/3 and keysort/2 * accept space under the top-level (same as ;) * modify portray_clause/1-2 to add a newline at the end of the output * add acyclic_term/1 (compatibility only since GNU Prolog does not handle cyclic terms) * fix write/1 to treat '$VARNAME'(Atom) as a var name only if Atom is a valid var name Mon Nov 29 15:48:25 CET 2010 * rename evaluable functor atan/2 as atan2/2 and >< as xor * add evaluable functor div/2 * detect op/3 error cases for | [] {} * replace type_error(variable, X) by uninstantiation_error(X) (e.g. open/3-4) Fri Nov 26 12:00:32 CEST 2010 * add built-in term_variables/2-3 and subsumes_term/2 Mon Nov 22 17:12:58 CEST 2010 * add some type tests on chars and codes (in number_chars/2, number_codes/2,..) Wed Nov 17 15:43:38 CEST 2010 * fix some little bugs in the parser * add meta_predicate property to predicate_property/2 Mon Oct 25 10:39:51 CEST 2010 * fix a memory leak in atom_concat/3 (in case of failure) Tue Jul 13 16:19:42 CEST 2010 * add infix operator '|' (and allow it to be unquoted in read/write) * improve top-level variables display adding () when needed Fri Jun 25 11:10:43 CEST 2010 * fix a bug in length/2 (length(L,L) now loops) Thu Jun 24 10:17:04 CEST 2010 * support the ISO multifile/1 directive * add built-ins false/0 and forall/2 * detect an instantiation_error in phrase/2-3 Fri Mar 31 15:52:42 CEST 2010 * GNU Prolog is now licensed under LGPL Tue Mar 16 11:35:32 CET 2010 * allow rounding functions to accept an integer if strict_iso is off Tue Dec 1 14:11:10 CET 2009 * group all examples under a new directory 'examples' Fri Nov 20 16:34:36 CET 2009 * fix a bug in read_from_codes/2 and number_codes/2 * improve speed of built-in predicates on list (append, member, reverse,...). Mon Nov 16 14:30:33 CET 2009 * improve CTRL+C handling under the top-level Thu Oct 22 11:11:02 CEST 2009 * add is_list/1 (same as list/1) Wed Oct 21 12:02:15 CEST 2009 * add Prolog flags: dialect, home, host_os, host_vendor, host_cpu, host, arch, version, version_data, unix, argv Tue Oct 20 13:15:44 CEST 2009 * add preprocessor directives if/1 else/0 elif/1 endif/0 Mon Oct 12 17:30:11 CEST 2009 * fix a bug on large ints in the byte-code for 64-bits machine * fix a bug with call/2-N * change listing/0-1 printing stream: now it is current_output * add a new stream alias: user_error associated to stderr Fri Oct 9 14:40:11 CEST 2009 * add evaluable functors: (a)sinh/1, (a)cosh/1, (a)tanh/1 * add evaluable functors: epsilon/0, lsb/1, msb/1, popcount/1 Thu Oct 8 17:26:36 CEST 2009 * fix compilation problem under Mac OS X Snow Leopard (force 32-bits mode) Wed Oct 7 16:14:16 CEST 2009 * add evaluable functors: log/2, gcd/2, tan/1, atan2/2, pi/0, e/0 * add built-in ground/1 * rename built-in sort0 as msort * add new error detection for keysort Tue Oct 6 12:47:32 CEST 2009 * accept (but ignore) directive encoding/1 * add xor/2 operator (bitwise XOR) ^/2 becomes integer exponentiation * improve randomize/0 (more different values on consecutive calls) * relax the lexer to also accept 0'' (ISO requires 0''' or 0'\') if strict_iso is off Tue Mar 10 17:14:36 CET 2009 * fix a bug with top-level options --entry-goal and --query-goal Fri Feb 6 11:02:57 CET 2009 * add working sigaction detection to detect fault addr (e.g. Mac OS X) Fri Jan 23 12:16:18 CET 2009 * add gplc option --no-mult-warn * add prolog flags suspicious_warning, multifile_warning Mon Nov 3 14:54:25 CEST 2008 * detect integer underflow/overflow in the parser * fix a memory leak in catch/3 Mon Oct 20 16:53:37 CEST 2008 * increase limits (MAX_VAR_NAME_LENGTH=1024 and MAX_VAR_IN_TERM=10240) * add PL_INT_LOWEST_VALUE and PL_INT_GREATEST_VALUE to gprolog.h Fri Oct 17 12:09:37 CEST 2008 * prefix all global symbols, constants and types with Pl_ PL_ Pl * fix a bug in the byte-code due to new max number of atoms * provide a minimal gprolog.h * detect if struct sigcontext needs asm/sigcontext.h on Linux Wed Oct 1 15:48:45 CEST 2008 * modify gplc: --c-compiler also sets linker and --linker added Tue Sep 30 15:12:00 CEST 2008 * port to x86_64/BSD - many thanks to David Holland * fix problem using ebx as global reg (bug in gcc 4.3.2) * fix a bug in is/2 with [X] (X should only be an integer) * fix a bug with atoms '/*' '*/' and '%' (were not quoted) * increase maximum number of atoms to 1048576 (2^20) * increase default stack sizes (16Mb for heap, 8Mb for others) Fri May 18 13:06:58 CEST 2007 * fix stack alignment for x86_64/Solaris Wed Mar 28 15:12:58 CEST 2007 * include patch from Paul Eggert for sparc/solaris8 Fri Mar 9 10:31:53 CET 2007 * port to x86_64/Solaris - many thanks to Scott L. Burson Thu Mar 8 14:12:50 CET 2007 * fix a bug in the FD solver (under 64 bits machines) * fix a bug in arithmetics (mod) Thu Jan 4 11:17:12 CET 2007 * change error messages emitted by the compiler to follow GNU standards Fri Dec 22 14:21:26 CET 2006 * modify doc (mainly rename manual.xxx to gprolog.xxx) * add DESTDIR variable support in main Makefile for staged installs Fri Dec 15 17:48:30 CET 2006 * fix a bug with Prolog floats in x86_64/Linux (bad stack alignment) * port for ix86/Darwin (Mac OS X) Fri Dec 8 16:59:49 CET 2006 * add check target to main Makefile Thu Dec 7 14:59:46 CET 2006 * improve Win32 ports (Cygwin, MinGW, MSVC 6.0 and 2005 Express Edition) (MSVC port uses MinGW as.exe instead of nasm.exe - named mingw-as.exe provided in the setup.exe) Mon Nov 27 18:38:09 CET 2006 * rename call/2 to call_det/2 * implement call/2-11 as will be defined in the next standard Fri Nov 24 18:38:25 CET 2006 * fix various problems when compiling with gcc 4 (gcc 4.1.1) * emit .note.GNU-stack to mark the stack as no executable in x86_any.c, x86_64_any.c and powerpc_any.c * change the way objects are found (obj_chain.c) using gcc ctors * use Doug Lea malloc for OpenBSD (problem with malloc using mmap) * fix problems in various ports: alpha/Linux, powerpc/Darwin (Mac OS X), sparc/solaris, ix86/OpenBSD Mon Jun 13 15:46:49 CEST 2005 * fix 2 bugs in global variables Mon Jun 7 15:22:44 CEST 2004 * fix problem when compiling with gcc 3.4.0 Fri Jun 4 15:16:30 CEST 2004 * fix bug in term comparison involving negative integers Thu Mar 11 16:58:43 CET 2004 * add consult, ... and fix minor bugs in the Win32 GUI console menu Tue Mar 2 15:54:37 CET 2004 * fix the stack overflow detection under Cygwin * port to ix86/MinGW - many thanks to Cesar Rabak Mon Feb 9 14:38:43 CET 2004 * fix a bug in the port to sparc/solaris Mon Nov 3 11:13:14 CET 2003 * fix a problem in the port to x86/OpenBSD Tue Sep 23 11:10:09 CEST 2003 * port to sparc/NetBSD and powerpc/NetBSD - many thanks to Jason Beegan Wed Apr 23 13:19:58 CEST 2003 * fix a bug in =../2 involving FD variables Fri Mar 21 14:09:26 CET 2003 * fix a bug in arithmetics (in float_{integer/fractional}_part) Thu Mar 6 09:28:20 CET 2003 * fix a bug in FD solver (wrong union with a singleton) Tue Feb 25 16:48:12 CET 2003 * fix a bug with the foreign C interface Wed Feb 19 18:10:22 CET 2003 * change configure.in: by default ebp is not used Mon Feb 17 13:45:05 CET 2003 * fix a but with CTRL+C handler not reinstalled Wed Jan 8 15:22:09 CET 2003 * fix a bug with _XXX (re)displayed under the top-level Mon Dec 16 13:00:42 CET 2002 * port to x86_64/Linux - many thanks to Gwenole Beauchesne Mon Sep 30 22:08:41 CEST 2002 * fix bug in predicate_property/2 Wed Sep 25 13:41:46 CEST 2002 * add new built-in fork_prolog/1 and create_pipe/2 Tue Sep 24 19:30:35 CEST 2002 * fix a bug in atom_concat/3 Thu Sep 19 12:53:45 CEST 2002 * fix bug when detecting if a stream can be repositioned Thu Sep 12 18:45:10 CEST 2002 * fix bug in output to constant terms (e.g. write_to_atom/2) * include another additional patch for sockets under win32 - due to Brent Fulgham * fix bug in bagof/3 with FD variables * fix bug with randomize/0 Fri Jun 21 18:32:06 CEST 2002 * added min/max to Prolog arithmetics Thu Jun 20 15:20:43 CEST 2002 * fix bugs in current_predicate and predicate_property Mon Jun 10 14:25:52 CEST 2002 * port to powerpc/Darwin (Mac OS X) - many thanks to Lindsey Spratt * fix bug in Win32 GUI console (deal with edit control text limit) * fix bug with in-place installation procedure Wed Apr 24 19:00:03 CEST 2002 * fix problem with portray_clause/2 using $VARNAME and $VAR now portray_clause((p(Z):-p('$VARNAME'('A'),Z))) is OK Tue Apr 23 13:13:18 CEST 2002 * fix bug with stream buffering (open/4 and set_stream_buffering/2) Sat Apr 21 13:09:54 CEST 2002 * add stream mirror facility (see add_stream_mirror/2) Fri Apr 19 15:20:51 CEST 2002 * improve global vars (arg. selector, automatic array, new built-ins) Sun Apr 14 16:35:10 CEST 2002 * fix two bugs with Ctrl+C reentrancy under the top-level Thu Apr 11 20:30:16 CEST 2002 * added priority/1 option to write_term to specify starting priority * now under the top-level, _XXX variables are not displayed Wed Apr 10 15:04:23 CEST 2002 * fix bug in decompose_file_name/4 (tried to modify read-only string) * now open/4 better detects if a stream can be repositioned Mon Apr 8 20:08:29 CEST 2002 * add source reader facility (built-in) - not yet documented * fix current_predicate bug, now current_predicate(nl/0) fails Fri Apr 5 12:32:26 CEST 2002 * fix linedit bug in tab pasting and add Esc-Tab function * now linedit goes to EOL at CR to fix bug with multi-line inputs * now linedit avoids to put in history 2 same consecutive lines * remove max_stream limitation (the Prolog flag no longer exists) * the template of get_print_stream/1 is now ?stream Thu Mar 28 00:35:59 CEST 2002 * patch to allow more than 64Mb for the stacks under ix86/Linux Mon Mar 25 13:34:52 CEST 2002 * fix a bug in wam2ma (hexa name creation overflowed malloc buffer) Fri Mar 22 11:31:52 CEST 2002 * fix a problem under sparc/solaris using mmap (adding MAP_FIXED) Tue Mar 19 18:51:50 CEST 2002 * fix a problem with gcc 3.0.x which always uses ebp in main() * use -march=xxx gcc option instead of -mxxx for ix86 Tue Jan 15 19:26:26 CEST 2002 * gplc now passes -L option to ld in the order of apparition * gplc accepts meta-characters %p, %d,... in output file names Tue Jan 8 16:51:48 CEST 2002 * include additional patch for sockets under win32 - due to Brent Fulgham Thu Dec 20 16:17:00 CEST 2001 * re-write Windows GUI Console in pure Win32 (no more MFC) * adapt configure.in to work with autoconf 2.52 Thu Dec 13 12:09:36 CEST 2001 * add Prolog flag back_quotes and values {atom,chars,codes}_no_escape * use a terminal recursion in FD arithmetic normalization Wed Dec 12 11:04:57 CEST 2001 * fix bug in bind_variables/2, reported by: Bowie Owens Tue Dec 11 18:25:19 CEST 2001 * modify Ma2Asm mappers to use Y_OFFSET (from ENVIR_STATIC_SIZE) * fix some bugs in the Wam debugger Fri Dec 7 19:01:02 CEST 2001 * add several options to the top-level to execute goals * add an environment variable LINEDIT to control linedit options * fix bug in linedit on \b in start of line (using ANSI ESC sequences) Tue Dec 4 20:29:00 CEST 2001 * simplify linedit: only apply to stdin * now linedit is reentrant * now linedit works with XFree keyboard encoding * rename built-in get_code_no_echo/1-2 by get_key_no_echo/1-2 * add built-in get_key/1-2 * use get_key/1-2 in the top_level + debugger (thus with echo) * improve the top-level Ctrl+C manager Mon Dec 3 18:13:16 CEST 2001 * fix bug on Linux configured with --disable-regs * add pipe to pl2wam stdin when called by consult/1 Mon Nov 5 10:25:29 CEST 2001 * fix bug in FD: forall is now recognized in .fd files * fix bug in DCG: expand_term((a --> X), Y) is OK Wed Oct 31 20:31:04 CEST 2001 * fix X paste problem in linedit Tue Oct 3O 17:31:04 CEST 2001 * simplify top_comp.c to better control include dirs in devel. mode Sun Oct 14 17:12:32 CEST 2001 * specialized functions for create/update/delete choice points Tue Oct 9 12:11:44 CEST 2001 * fix a bug in wam2ma (hexa name creation overflowed malloc buffer) Mon Oct 8 12:33:02 CEST 2001 * include patch to support basic sockets under win32 - due to Brent Fulgham * arithmetic functions and inlined built-ins use fast call * specialized functions for switch_on_term_xxx * modify pl2wam to generalize '$call_c' (add options) Mon Oct 8 11:33:02 CEST 2001 * fix bug - delete file created by mkstemp(2), patch from: Salvador Abreu Fri Sep 28 17:09:35 CEST 2001 * space_args(true) now displays a space inside {}/1 * space_args(true) now displays a space after a comma (','/2) Sat Sep 15 12:49:19 CET 2001 * add a --foreign-only option to pl2wam * foreign/2 directives are ignored in byte-code mode (no fatal error) Fri Sep 7 09:58:36 CET 2001 * space_args(true) now displays space between operators and arguments * add CVS Id to prolog files * fix bug in pl2wam to include break/0, trace/0,... in bip_list.pl Thu Jul 12 16:03:30 CET 2001 * get rid of mktemp and tempnam calls (use mkstemp if available) Thu Jun 7 20:34:13 CET 2001 * fix a bug in fd_element_var/3 constraint Thu Feb 8 11:25:30 CET 2001 * fix bug in fd headers (fd_to_c.h not installed) Thu Jan 25 21:12:06 CET 2001 * fix a bug with unify_with_occurs_check/2 * fix bug on ix86 using ebp (add -fomit-frame-pointer in CFLAGS_MACHINE) Mon Jan 22 12:41:26 CET 2001 * fix a bug with ! in dynamic code * fix a bug in arithmetics Tue Dec 19 16:32:39 CET 20000 * big modification (1 month) to optimize the execution speed Thu Nov 9 19:06:06 CEST 2000 * implement fast call (mainly for WAM functions) Tue Nov 7 15:12:11 CEST 2000 * modify C->Prolog foreign interface to recover arguments space Mon Nov 6 14:58:07 CEST 2000 * improve dynamic clause management and fix a bug (memory leak) Fri Nov 3 09:17:19 CEST 2000 * fix _ symbol prefix problem for Free BSD Fri Oct 13 17:46:38 CEST 2000 * no longer use dl_malloc on Linux but prevent MMAP using mallopt Tue Sep 12 15:42:48 CEST 2000 * full re-indentation of the sources for CVS Thu Sep 7 18:04:15 CEST 2000 * added acos/asin to Prolog arithmetics Wed Sep 6 20:04:15 CEST 2000 * port to alpha/Linux - many thanks to Alexander Diemand * port to alpha/OSF1 * port to mips/irix - many thanks to Alexander Diemand * fix a bug in stty.c (use standard termios if present) Mon Jul 31 11:42:44 CEST 2000 * fix a bug in stty.c (use termio by default and else termios) Thu Jul 6 11:38:58 CEST 2000 * more customizable configuration/installation procedure Mon Jun 3 19:57:20 CEST 2000 * port for ix86/NetBSD - many thanks to Brook Milligan Wed Jun 28 11:38:37 CEST 2000 * rename configuration file config.h by gp_config.h Mon Jun 19 14:24:44 CEST 2000 * avoid to establish a connection at start to get the hostname Tue Jun 6 16:51:48 CEST 2000 * fix a bug in the compiler about \\ inside quoted atoms Thu May 4 17:39:53 CEST 2000 * fix a bug in dynamic clause retraction (memory leak) Tue Apr 25 16:32:09 CEST 2000 * fix a bug in atom management (existing atoms eat mallocated space) Tue Apr 18 13:23:02 CEST 2000 * added creation/1 and last_access/1 property to file_property/2 Wed Mar 1 14:23:45 CEST 2000 * start of native Win32 port Mon Feb 14 14:00:46 CET 2000 * port for ix86/FreeBSD - many thanks to Nicolas Ollinger Tue Jan 18 17:30:25 CET 2000 * fix a bug in the byte-code loader (bad realloc computation) * fix a bug in the malloc (used MMAP under Linux) Fri Dec 17 15:54:51 CET 1999 * port for ix86/SCO - many thanks to Clive Cox and Edmund Grimley Evans * port for ix86/solaris - many thanks to Andreas Stolcke Thu Dec 16 18:23:13 CET 1999 * fix a bug in the FD solver for X#\=C (if C is max(X)) Thu Dec 2 17:31:31 CET 1999 * fix a bug with directory_files/2 (too many open files) Thu Nov 25 14:27:11 CET 1999 * fix a bug in the compiler about \t in quoted atoms Fri Oct 22 14:59:47 CEST 1999 * fix a bug in the scanner about 0' Mon Oct 18 12:46:59 CEST 1999 * fix bug with popen/3 * update machine.c for struct sigcontext under Linux Fri Oct 8 19:36:59 CEST 1999 * fix a bug in the output of some extended characters in native-compilation Tue Sep 28 18:00:44 CEST 1999 * implementation of call_with_args Mon Sep 27 16:18:55 CEST 1999 * fix a bug in sign/1 for arithmetic evaluation Fri Jul 16 13:26:31 CEST 1999 * fix a bug in foreign C calling Prolog on sparc Thu Jul 15 12:04:38 CEST 1999 * fix a bug in sparc compilation * fix a bug in foreign code under sparc * update pl_config.c to show which version is installed Tue Jul 6 14:47:51 CEST 1999 * add linedit test to avoid to re-echo an already buffered full-line * fix bugs is sort/1 Fri Jun 25 10:04:03 CEST 1999 * fix bug in sleep/1 (incorrect behavior with a float) * finish preliminary port to Cygwin (see file src/PROBLEMS) Wed Jun 23 13:49:07 MEST 1999 * fix bug in FD solver (too much trail allocated due to bad vec_size) * fix labeling first-fail to correspond to clp(FD) Fri Jun 18 12:29:03 CEST 1999 * fix message from consult when pl2wam cannot be found Thu Jun 17 16:12:53 MEST 1999 * fix precision bug on floating constants Sun Jun 6 12:05:32 CEST 1999 * initial port for ix86/Cygwin (Win32) (to finish) Fri Jun 4 11:05:37 CEST 1999 * fix bug in throw_c.c (foreign code catch exception) * improve Ma2Asm check.c and FromC/ utilities * port for PowerPC / GNU/Linux (see file src/PROBLEMS) Mon May 31 10:45:35 CEST 1999 * fix bug using egcs-1.1.2 (RedHat 6.0) (add a Stop_Prolog() fct) Fri May 21 15:56:50 MEST 1999 * removed Configure directory (clashes with ./configure under WinXX) * fix Linedit/Makefile.in (CFLAGS added) Fri May 21 11:54:31 MEST 1999 * add ensure_linked directive * fix bug in gplc help (-C/-A/-L instead of --C/--A/--L) * fix bug in gplc (with too long command-lines) * fix bug in M_Absolute_Path_Name() (/.automount gave /automount) Wed Apr 21 09:53:00 MEST 1999 * work release 1.0.1 * fix bug --disable-regs works now for solaris Mon Apr 19 19:46:07 MEST 1999 * optimize FD equations (math_supp.c) avoid qsort sometimes * fix bug in installation procedure (Html doc installation) Fri Apr 16 15:49:34 MEST 1999 * rewrite in C DCG translation: optimize unifications, no more ill-balanced conjunctions * fix bug in bc_supp.c to avoid aux pred name for unknown predicate * fix bug in pl2wam (:- set_prolog_flag(singleton_warning,off)) Thu Apr 8 19:09:40 MEST 1999 * current_prolog/1 conforms to ISO thanks to strict_iso flag * fix bug (type_list instead of instantiation error for Options) * fix bug setof (not sorted when comes down to findall) Tue Apr 6 20:48:32 MEST 1999 * add Prolog flag strict_iso (to relax predicate indicators) * fix number_chars and friends non ISO conforming behavior * modify wam2ma to avoid static arrays (use dynamic allocation) Sun Apr 4 15:28:12 MET 1999 * add in-place installation (modify configure.in and Makefile.in) Wed Mar 31 16:26:10 MET 1999 * add copyright headers in source files Thu Mar 30 17:20:10 MET 1999 * rewrite all solutions built-in predicates (in C) * add in-place sorts Wed Mar 24 10:12:02 MET 1999 * rewrite DCG translations Mon Mar 22 19:42:12 MET 1999 * fix compiler bug in wam2ma (atom using \xHH\ not correctly handled) Fri Mar 19 19:42:12 MET 1999 * rewrite sorts built-in predicates (in C) Mon Mar 15 10:12:02 MET 1999 * Calypso (beta 7) becomes GNU Prolog 0.9.0 change command names (calypso -> gprolog, plcc -> gplc,...) copyright messages (--version),... Fri Mar 12 09:38:24 MET 1999 * fail/0 caused an existence_error under the debugger Wed Mar 10 11:57:25 MET 1999 * user/built_in/built_in_fd not recognized by load/1 Mon Mar 8 20:39:25 MET 1999 * Calypso version 1.0-beta7 ready for internal use gprolog-1.4.5/VERSION0000644000175000017500000000001613021356406012367 0ustar spaspagprolog-1.4.5 gprolog-1.4.5/examples/0000755000175000017500000000000013021324543013135 5ustar spaspagprolog-1.4.5/examples/ExamplesFD/0000755000175000017500000000000013021324543015125 5ustar spaspagprolog-1.4.5/examples/ExamplesFD/bdonald.pl0000644000175000017500000000760513021324543017075 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bdonald.pl */ /* Title : crypt-arithmetic */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* Solve the operation: */ /* */ /* D O N A L D */ /* + G E R A L D */ /* -------------- */ /* = R O B E R T */ /* */ /* (resolution by column) */ /* The digit of each letter is coded in binary on 4 bits (dcb). The order */ /* for labeling is very relevant for efficiency. */ /* */ /* Solution: */ /* [D,O,N,A,L,G,E,R,B,T] */ /* [5,2,6,4,8,1,9,7,3,0] */ /* [[0,1,0,1],[0,0,1,0],[0,1,1,0],[0,1,0,0],[1,0,0,0],[0,0,0,1],[1,0,0,1],*/ /* [0,1,1,1],[0,0,1,1],[0,0,0,0]] */ /* ie: */ /* [5,2,6,4,8,1,9,7,3,0] */ /*-------------------------------------------------------------------------*/ q :- statistics(runtime, _), ( bdonald(A), write(A), nl, fail ; write('No more solutions'), nl ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. bdonald(Ar) :- Ar = [D, O, N, A, L, G, E, R, B, T], dcb_digit(D), dcb_digit(O), dcb_digit(N), dcb_digit(A), dcb_digit(L), dcb_digit(G), dcb_digit(E), dcb_digit(R), dcb_digit(B), dcb_digit(T), diff0(D), diff0(G), all_dcb_digit_diff(Ar), LC = [C1, C2, C3, C4, C5], dcb_add(0, D, D, T, C1), dcb_add(C1, L, L, R, C2), dcb_add(C2, A, A, E, C3), dcb_add(C3, N, R, B, C4), dcb_add(C4, O, E, O, C5), dcb_add(C5, D, G, R, 0), !, array_labeling([D, A, L, O, N, E, G, R, B, T]), fd_labeling(LC). dcb_digit(D) :- D = [B3, B2, B1, _], B3 #==> #\ B2 #/\ #\ B1. diff0([B3, B2, B1, B0]) :- B3 #\/ B2 #\/ B1 #\/ B0. all_dcb_digit_diff([]). all_dcb_digit_diff([X|L]) :- diff_of(L, X), all_dcb_digit_diff(L). diff_of([], _). diff_of([Y|L], X) :- dcb_digit_diff(X, Y), diff_of(L, X). dcb_digit_diff([X3, X2, X1, X0], [Y3, Y2, Y1, Y0]) :- #\ ((X3 #<=> Y3) #/\ (X2 #<=> Y2) #/\ (X1 #<=> Y1) #/\ (X0 #<=> Y0)). dcb_add(CI, [X3, X2, X1, X0], [Y3, Y2, Y1, Y0], [Z3, Z2, Z1, Z0], CO) :- full_add(CI, X0, Y0, Z0, C1), full_add(C1, X1, Y1, I1, C2), full_add(C2, X2, Y2, I2, C3), full_add(C3, X3, Y3, I3, C4), I2 #\/ I1 #<=> I12, I3 #/\ I12 #<=> I123, C4 #\/ I123 #<=> Hex, half_add(I1, Hex, Z1, D2), full_add(D2, I2, Hex, Z2, D3), half_add(D3, I3, Z3, D4), C4 #\/ D4 #<=> CO. full_add(CI, X, Y, Z, CO) :- half_add(X, Y, Z1, C1), half_add(CI, Z1, Z, C2), C1 #\/ C2 #<=> CO. half_add(X, Y, Z, CO) :- X #/\ Y #<=> CO, X ## Y #<=> Z. :- include(array). % interface with for_each_... procedures array_prog(_, _). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bsend.pl0000644000175000017500000000744413021324543016566 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bsend.pl */ /* Title : crypt-arithmetic */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* Solve the operation: */ /* */ /* S E N D */ /* + M O R E */ /* ----------- */ /* = M O N E Y */ /* */ /* (resolution by column) */ /* The digit of each letter is coded in binary on 4 bits (dcb). The order */ /* for labeling is very relevant for efficiency. */ /* */ /* Solution: */ /* [S,E,N,D,M,O,R,Y] */ /* [[1,0,0,1],[0,1,0,1],[0,1,1,0],[0,1,1,1],[0,0,0,1],[0,0,0,0],[1,0,0,0],*/ /* [0,0,1,0]] */ /* ie: */ /* [9,5,6,7,1,0,8,2] */ /*-------------------------------------------------------------------------*/ q :- statistics(runtime, _), ( bsend(A), write(A), nl %, % fail ; write('No more solutions'), nl ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. bsend(A) :- A = [S, E, N, D, M, O, R, Y], dcb_digit(S), dcb_digit(E), dcb_digit(N), dcb_digit(D), dcb_digit(M), dcb_digit(O), dcb_digit(R), dcb_digit(Y), diff0(S), diff0(M), all_dcb_digit_diff(A), LC = [C1, C2, C3, C4], Z = [0, 0, 0, 0], dcb_add(0, D, E, Y, C1), dcb_add(C1, N, R, E, C2), dcb_add(C2, E, O, N, C3), dcb_add(C3, S, M, O, C4), dcb_add(C4, Z, Z, M, 0), !, array_labeling(A), fd_labeling(LC). dcb_digit(D) :- D = [B3, B2, B1, _], B3 #==> #\ B2 #/\ #\ B1. diff0([B3, B2, B1, B0]) :- B3 #\/ B2 #\/ B1 #\/ B0. all_dcb_digit_diff([]). all_dcb_digit_diff([X|L]) :- diff_of(L, X), all_dcb_digit_diff(L). diff_of([], _). diff_of([Y|L], X) :- dcb_digit_diff(X, Y), diff_of(L, X). dcb_digit_diff([X3, X2, X1, X0], [Y3, Y2, Y1, Y0]) :- #\ ((X3 #<=> Y3) #/\ (X2 #<=> Y2) #/\ (X1 #<=> Y1) #/\ (X0 #<=> Y0)). dcb_add(CI, [X3, X2, X1, X0], [Y3, Y2, Y1, Y0], [Z3, Z2, Z1, Z0], CO) :- full_add(CI, X0, Y0, Z0, C1), full_add(C1, X1, Y1, I1, C2), full_add(C2, X2, Y2, I2, C3), full_add(C3, X3, Y3, I3, C4), I2 #\/ I1 #<=> I12, I3 #/\ I12 #<=> I123, C4 #\/ I123 #<=> Hex, half_add(I1, Hex, Z1, D2), full_add(D2, I2, Hex, Z2, D3), half_add(D3, I3, Z3, D4), C4 #\/ D4 #<=> CO. full_add(CI, X, Y, Z, CO) :- half_add(X, Y, Z1, C1), half_add(CI, Z1, Z, C2), C1 #\/ C2 #<=> CO. half_add(X, Y, Z, CO) :- X #/\ Y #<=> CO, X ## Y #<=> Z. :- include(array). % interface with for_each_... procedures array_prog(_, _). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/qg5.pl0000644000175000017500000000523313021324543016161 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : qg5.pl */ /* Title : Quasi-group problem QG5 */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : July 1998, modified 2009 */ /* */ /* Find a semigroup table so that: ((xy)x)x=y under idempotency hypothesis.*/ /* */ /* Solution: */ /* N = 5 [[1,5,4,2,3],[3,2,5,1,4],[2,4,3,5,1],[5,3,1,4,2],[4,1,2,3,5]] */ /* */ /* table (x.y is at col x, row y) */ /* 1 5 4 2 3 */ /* 3 2 5 1 4 */ /* 2 4 3 5 1 */ /* 5 3 1 4 2 */ /* 4 1 2 3 5 */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), qg5(N, A), statistics(runtime, [_, Y]), write(A), nl, write_array(A, '%3d', 0), write('time : '), write(Y), nl. qg5(N, A) :- fd_set_vector_max(N), create_array(N, N, A), array_values(A, L), fd_domain(L, 1, N), for_each_line(A, alldiff), for_each_column(A, alldiff), last(A, Last), isomorphic_cstr(Last, 0), axioms_cstr(1, N, A), fd_labelingff(L). array_prog(alldiff, L) :- fd_all_different(L). isomorphic_cstr([], _). isomorphic_cstr([X|L], K) :- X #>= K, K1 is K + 1, isomorphic_cstr(L, K1). axioms_cstr(I, N, A) :- I =< N, !, nth(I, A, L), axioms_cstr1(1, N, I, L, A), I1 is I + 1, axioms_cstr(I1, N, A). axioms_cstr(_, _, _). axioms_cstr1(J, N, I, L, A) :- J =< N, !, array_elem(A, J, I, V1), ( I = J -> V1 = I % idempotency ; fd_element_var(V1, L, V2), fd_element_var(V2, L, J) ), J1 is J + 1, axioms_cstr1(J1, N, I, L, A). axioms_cstr1(_, _, _, _, _). :- include(array). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/partit.pl0000644000175000017500000002224513021324543016772 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : partit.pl */ /* Title : integer partitionning */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1993 (modified March 1997, feb 2010) */ /* */ /* Partition numbers 1,2,...,N into two groups A and B such that: */ /* a) A and B have the same length, */ /* b) sum of numbers in A = sum of numbers in B, */ /* c) sum of squares of numbers in A = sum of squares of numbers in B. */ /* */ /* It seems there is a solution if N >= 8 and N is a multiple of 4. */ /* */ /* Two redundant constraints are used: */ /* */ /* - in order to avoid duplicate solutions (permutations) we impose */ /* A1 X, ascending_order(L, Y). cstr_pow(P, N, A, B) :- sum_power(P, N, S), compute_and_check_half_sum(N, P, S, HS), cstr_pow(A, P, HS), cstr_pow(B, P, HS). cstr_pow([], _, 0). cstr_pow([X|L], P, S) :- X ** P #= XP, S #= XP + S1, cstr_pow(L, P, S1). /* Known sums of powers * sum of n first integers: s1(n) = n * (n+1) / 2 * sum of n first squares : s2(n) = n * (n+1) * (2*n+1)/ 6 * sum of n first cubes : s3(n) = n^2 * (n+1)^2 / 4 = s1(n)^2 * sum of n fisrt pow 4 : s4(n) = n * (n+1) * (6*n^3 + 9*n^2 + n - 1 ) / 30 */ sum_power(1, N, S) :- S is N * (N + 1) // 2. sum_power(2, N, S) :- S is N * (N + 1) * (2 * N + 1) // 6. sum_power(3, N, S) :- sum_power(1, N, S2), S is S2 * S2. sum_power(4, N, S) :- S is N * (N+1) * (6*N^3 + 9*N^2 + N - 1) // 30. /* The labeling heuristics consists in placing the biggest missing value (from N to 1) */ enum_all(1, _, _) :- !. enum_all(N, [N|A], B) :- N1 is N - 1, enum_all(N1, A, B). enum_all(N, A, [N|B]) :- N1 is N - 1, enum_all(N1, A, B). /* If only one solution is wanted, it is better to first try to put the biggest missing value * in the group which has the smallest sum (of already placed values). */ enum_one(1, _, _, _, _) :- !. enum_one(N, SumA, SumB, A, B) :- SumA > SumB, !, enum_one(N, SumB, SumA, B, A). enum_one(N, SumA, SumB, [N|A], B) :- % in A first (which has the smallest sum) then... SumA1 is SumA + N, N1 is N - 1, enum_one(N1, SumA1, SumB, A, B). enum_one(N, SumA, SumB, A, [N|B]) :- % in B at backtracking SumB1 is SumB + N, N1 is N - 1, enum_one(N1, SumA, SumB1, A, B). :- initialization(q). %%% to compute the number of solutions all(N) :- g_assign(nb,0), user_time(T0), all(N, T0). all(N, T0) :- partit(N, _, _), g_inc(nb, NB), NB mod 100000 =:= 0, % adapt this to have more or less displayed lines show_time(NB, T0), fail. all(N, T0) :- g_read(nb, NB), format('\nfinal for partit ~d:\n\n', [N]), show_time(NB, T0). show_time(NB, T0) :- user_time(T1), T is (T1 - T0), format('%10d solutions in ', [NB]), disp_time(T), TA is T / NB, write('\n average '), disp_time(TA), write(' / sol\n'). disp_time(T) :- T1 is T / 1000, format('%20.6f secs =', [T1]), disp_time([86400000-d,3600000-h,60000-m,1000-s,1-ms], T, nothing_yet_displayed). disp_time([], T, nothing_yet_displayed) :- !, format(' %.3f ms', [T]). disp_time([], _, _). disp_time([M-_|LM], T, nothing_yet_displayed) :- T < M, !, disp_time(LM, T, nothing_yet_displayed). disp_time([M-U|LM], T, _) :- N is truncate(T / M), T1 is T - (N * M), format(' ~d~a', [N, U]), disp_time(LM, T1, something_is_displayed). gprolog-1.4.5/examples/ExamplesFD/square.pl0000644000175000017500000001233413021324543016765 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : square.pl */ /* Title : perfect square */ /* Original Source: Pascal Van Hentenryck ([VHSD93]) */ /* Adapted by : Gregory Sidebottom (Nicolog) and Daniel Diaz (clp(FD)) */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : June 1994 */ /* */ /* This program solves the perfect square packing problem (SPP): find a way*/ /* to pack all the given squares (i.e. known sizes) into a master rectangle*/ /* so that none overlap and there is no wasted space. */ /* There are 4 instances of the problem (P=3 corresponds to [VSHD93]). */ /* */ /* Solution: */ /* 1 x([ 0, 0,18,22,23,15,15,18,22]) 2 x([ 0,41,42, 0,22,25,25,36,36,22]) */ /* y([ 0,18, 0,14,24,25,18,14,24]) y([ 0,23, 0,25,28, 0,17,17,23,25]) */ /* s([18,15,14,10, 9, 8, 7, 4, 1]) s([25,24,23,22,19,17,11, 6, 5, 3]) */ /* */ /* 3 x([ 0,70,75, 0,79,50 ,0,50,46,27,52,35,59,35,35,50,27,52,46,75,50]) */ /* y([ 0,70,33,50, 0, 0,85,29,88,93,70,65,54,50,82,54,85,63,82,29,63]) */ /* s([50,42,37,35,33,29,27,25,24,19,18,17,16,15,11, 9, 8, 7, 6, 4, 2]) */ /* */ /* 4 x([ 0,111, 0, 56, 81,132, 72, 0,140,142,111,81,111, 38, 38, 56, 58,*/ /* 63,132, 58, 59, 56,140, 58]) */ /* y([ 0,111, 81, 81, 0, 0,136,137, 43, 78, 80,51, 51,155,137,136,161,*/ /* 152, 43,156,152,152, 78,155]) */ /* s([ 81, 64, 56, 55, 51, 43, 39, 38, 35, 33, 31,30, 29, 20, 18, 16, 14,*/ /* 9, 8, 5, 4, 3, 2, 1]) */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), square(N, Xs, Ys, Ss), statistics(runtime, [_, Y]), write(x(Xs)), nl, write(y(Ys)), nl, write(s(Ss)), nl, write('time : '), write(Y), nl. problem(1, 32, 33, [18, 15, 14, 10, 9, 8, 7, 4, 1]). problem(2, 65, 47, [25, 24, 23, 22, 19, 17, 11, 6, 5, 3]). problem(3, 112, 112, [50, 42, 37, 35, 33, 29, 27, 25, 24, 19, 18, 17, 16, 15, 11, 9, 8, 7, 6, 4, 2]). problem(4, 175, 175, [81, 64, 56, 55, 51, 43, 39, 38, 35, 33, 31, 30, 29, 20, 18, 16, 14, 9, 8, 5, 4, 3, 2, 1]). problem(5, 479, 479, [175, 174, 164, 160, 155, 150, 140, 130, 86, 77, 68, 60, 52, 44, 43, 35, 29, 28, 26, 24, 23, 17, 6, 5]). problem(6, 655, 655, [288, 246, 216, 215, 194, 193, 173, 152, 151, 86, 84, 83, 65, 57, 54, 53, 51, 40, 31, 26, 25, 21, 15, 14, 10]). % adaptive search examples problem(-1, 112, 112, [50, 42, 37, 35, 33, 29, 27, 25, 24, 19, 18, 17, 16, 15, 11, 9, 8, 7, 6, 4, 2]). problem(-4, 479, 479, [175,174,164,160,155,150,140,130,86,77,68,60,52,44,43,35,29,28,26,24,23,17,6,5]). problem(-5, 524, 524, [220,164,163,159,145,141,135,132,125,101,98,90,87,62,61,55,54,39,37,35,33,21,20,12,9]). square(P, Xs, Ys, Ss) :- gen(P, Xs, Ys, Ss, SX, SY), ( SX >= SY -> MaxS = SX ; MaxS = SY ), fd_set_vector_max(MaxS), no_overlap(Xs, Ys, Ss), cap(Xs, Ss, SX, SY), cap(Ys, Ss, SY, SX), label(Xs), label(Ys). gen(P, Xs, Ys, Ss, SX, SY) :- problem(P, SX, SY, Ss), gen_coords(Ss, Xs, Ys, SX, SY). gen_coords([], [], [], _, _). gen_coords([S|Ss], [X|Xs], [Y|Ys], SX, SY) :- X #=< SX - S, Y #=< SY - S, gen_coords(Ss, Xs, Ys, SX, SY). no_overlap([], [], []). no_overlap([X|Xs], [Y|Ys], [S|Ss]) :- no_overlap1(Xs, Ys, Ss, X, Y, S), no_overlap(Xs, Ys, Ss). no_overlap1([], [], [], _, _, _). no_overlap1([X2|Xs], [Y2|Ys], [S2|Ss], X1, Y1, S1) :- X1 + S1 #=< X2 #\/ X1 #>= X2 + S2 #\/ Y1 + S1 #=< Y2 #\/ Y1 #>= Y2 + S2, no_overlap1(Xs, Ys, Ss, X1, Y1, S1). cap(Xs, Ss, SX, SY) :- cap1(0, SX, SY, Xs, Ss). cap1(P, SX, SY, Xs, Ss) :- ( P < SX -> sum_of_squares_with(Xs, Ss, P, SY), P1 is P + 1, cap1(P1, SX, SY, Xs, Ss) ; true ). sum_of_squares_with([], [], _, 0). sum_of_squares_with([X|Xs], [S|Ss], P, Sum) :- point_used_by_square_iff_b(P, X, S, B), Sum #= S * B + Sum1, sum_of_squares_with(Xs, Ss, P, Sum1). % X<=P B P and S are ground point_used_by_square_iff_b(P, X, S, B) :- B #<=> X #=< P #/\ P #< X + S. label([]). label([X|Xs]) :- list_min([X|Xs], Min), select_square([X|Xs], Min, Rest), label(Rest). list_min([X|Xs], Min) :- fd_min(X, Min1), list_min1(Xs, Min1, Min). list_min1([], M, M). list_min1([X|Xs], M1, M) :- fd_min(X, M2), ( M1 =< M2 -> M3 = M1 ; M3 = M2 ), list_min1(Xs, M3, M). select_square([X|Xs], X, Xs). select_square([X|Xs], Min, [X|Rest]) :- X #> Min, select_square(Xs, Min, Rest). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bschur.pl0000644000175000017500000000504513021324543016754 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bschur.pl */ /* Title : Schur's lemma */ /* Original Source: Giovanna Dore - Italy */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* Color the integers 1,2...,N with 3 colors so that there is no monochrome*/ /* triplets (x,y,z) where x+y=z. Solution iff N<=13. */ /* The solution is a list [ [Int11,Int12,Int13],..., [IntN1,IntN2,IntN3] ] */ /* where Intij is 1 if the integer i is colored with the color j. */ /* */ /* Solution: */ /* N=4 [[0,0,1],[0,1,0],[0,0,1],[1,0,0]] */ /* [[0,0,1],[0,1,0],[0,1,0],[0,0,1]] */ /* ... */ /* N=13 [[0,0,1],[0,1,0],[0,1,0],[0,0,1],[1,0,0],[1,0,0],[0,0,1],[1,0,0], */ /* [1,0,0],[0,0,1],[0,1,0],[0,1,0],[0,0,1]] (first solution) */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), ( schur(N, A), write(A), nl, fail ; write('No more solutions'), nl ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. schur(N, A) :- create_array(N, 3, A), for_each_line(A, only1), pair_constraints(A, A), !, array_labeling(A). pair_constraints([], _) :- !. pair_constraints([_], _) :- !. pair_constraints([_, [K1, K2, K3]|A2], [[I1, I2, I3]|A1]) :- #\ (I1 #/\ K1), #\ (I2 #/\ K2), #\ (I3 #/\ K3), triplet_constraints(A2, A1, [I1, I2, I3]), pair_constraints(A2, A1). triplet_constraints([], _, _). triplet_constraints([[K1, K2, K3]|A2], [[J1, J2, J3]|A1], [I1, I2, I3]) :- #\ (I1 #/\ J1 #/\ K1), #\ (I2 #/\ J2 #/\ K2), #\ (I3 #/\ J3 #/\ K3), triplet_constraints(A2, A1, [I1, I2, I3]). :- include(array). % interface with for_each_... procedures array_prog(only1, L) :- fd_only_one(L). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/crypta.pl0000644000175000017500000000542113021324543016766 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : crypta.pl */ /* Title : crypt-arithmetic */ /* Original Source: P. Van Hentenryck's book */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* Solve the operation: */ /* */ /* B A I J J A J I I A H F C F E B B J E A */ /* + D H F G A B C D I D B I F F A G F E J E */ /* ----------------------------------------- */ /* = G J E G A C D D H F A F J B F I H E E F */ /* */ /* Solution: */ /* [A,B,C,D,E,F,G,H,I,J] */ /* [1,2,3,4,5,6,7,8,9,0] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), crypta(Lab, LD), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. crypta(Lab, LD) :- fd_set_vector_max(9), LD = [A, B, C, D, E, F, G, H, I, J], fd_domain(LD, 0, 9), fd_domain([Sr1, Sr2], 0, 1), fd_domain([B, D, G], 1, 9), fd_all_different(LD), A + 10 * E + 100 * J + 1000 * B + 10000 * B + 100000 * E + 1000000 * F + E + 10 * J + 100 * E + 1000 * F + 10000 * G + 100000 * A + 1000000 * F #= F + 10 * E + 100 * E + 1000 * H + 10000 * I + 100000 * F + 1000000 * B + 10000000 * Sr1, C + 10 * F + 100 * H + 1000 * A + 10000 * I + 100000 * I + 1000000 * J + F + 10 * I + 100 * B + 1000 * D + 10000 * I + 100000 * D + 1000000 * C + Sr1 #= J + 10 * F + 100 * A + 1000 * F + 10000 * H + 100000 * D + 1000000 * D + 10000000 * Sr2, A + 10 * J + 100 * J + 1000 * I + 10000 * A + 100000 * B + B + 10 * A + 100 * G + 1000 * F + 10000 * H + 100000 * D + Sr2 #= C + 10 * A + 100 * G + 1000 * E + 10000 * J + 100000 * G, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/eq20.pl0000644000175000017500000000725313021324543016240 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : eq20.pl */ /* Title : linear equations */ /* Original Source: Thomson LCR */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* A system involving 7 variables and 20 equations */ /* */ /* Solution: */ /* [X1,X2,X3,X4,X5,X6,X7] */ /* [ 1, 4, 6, 6, 6, 3, 1] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), eq20(LD, Lab), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. eq20(LD, Lab) :- LD = [X1, X2, X3, X4, X5, X6, X7], fd_domain(LD, 0, 10), 876370 + 16105 * X1 + 6704 * X3 + 68610 * X6 #= 0 + 62397 * X2 + 43340 * X4 + 95100 * X5 + 58301 * X7, 533909 + 96722 * X5 #= 0 + 51637 * X1 + 67761 * X2 + 95951 * X3 + 3834 * X4 + 59190 * X6 + 15280 * X7, 915683 + 34121 * X2 + 33488 * X7 #= 0 + 1671 * X1 + 10763 * X3 + 80609 * X4 + 42532 * X5 + 93520 * X6, 129768 + 11119 * X2 + 38875 * X4 + 14413 * X5 + 29234 * X6 #= 0 + 71202 * X1 + 73017 * X3 + 72370 * X7, 752447 + 58412 * X2 #= 0 + 8874 * X1 + 73947 * X3 + 17147 * X4 + 62335 * X5 + 16005 * X6 + 8632 * X7, 90614 + 18810 * X3 + 48219 * X4 + 79785 * X7 #= 0 + 85268 * X1 + 54180 * X2 + 6013 * X5 + 78169 * X6, 1198280 + 45086 * X1 + 4578 * X3 #= 0 + 51830 * X2 + 96120 * X4 + 21231 * X5 + 97919 * X6 + 65651 * X7, 18465 + 64919 * X1 + 59624 * X4 + 75542 * X5 + 47935 * X7 #= 0 + 80460 * X2 + 90840 * X3 + 25145 * X6, 0 + 43525 * X2 + 92298 * X3 + 58630 * X4 + 92590 * X5 #= 1503588 + 43277 * X1 + 9372 * X6 + 60227 * X7, 0 + 47385 * X2 + 97715 * X3 + 69028 * X5 + 76212 * X6 #= 1244857 + 16835 * X1 + 12640 * X4 + 81102 * X7, 0 + 31227 * X2 + 93951 * X3 + 73889 * X4 + 81526 * X5 + 68026 * X7 #= 1410723 + 60301 * X1 + 72702 * X6, 0 + 94016 * X1 + 35961 * X3 + 66597 * X4 #= 25334 + 82071 * X2 + 30705 * X5 + 44404 * X6 + 38304 * X7, 0 + 84750 * X2 + 21239 * X4 + 81675 * X5 #= 277271 + 67456 * X1 + 51553 * X3 + 99395 * X6 + 4254 * X7, 0 + 29958 * X2 + 57308 * X3 + 48789 * X4 + 4657 * X6 + 34539 * X7 #= 249912 + 85698 * X1 + 78219 * X5, 0 + 85176 * X1 + 57898 * X4 + 15883 * X5 + 50547 * X6 + 83287 * X7 #= 373854 + 95332 * X2 + 1268 * X3, 0 + 87758 * X2 + 19346 * X4 + 70072 * X5 + 44529 * X7 #= 740061 + 10343 * X1 + 11782 * X3 + 36991 * X6, 0 + 49149 * X1 + 52871 * X2 + 56728 * X4 #= 146074 + 7132 * X3 + 33576 * X5 + 49530 * X6 + 62089 * X7, 0 + 29475 * X2 + 34421 * X3 + 62646 * X5 + 29278 * X6 #= 251591 + 60113 * X1 + 76870 * X4 + 15212 * X7, 22167 + 29101 * X2 + 5513 * X3 + 21219 * X4 #= 0 + 87059 * X1 + 22128 * X5 + 7276 * X6 + 57308 * X7, 821228 + 76706 * X1 + 48614 * X6 + 41906 * X7 #= 0 + 98205 * X2 + 23445 * X3 + 67921 * X4 + 24111 * X5, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/Makefile0000644000175000017500000000424013021324543016565 0ustar spaspaGPLC = gplc GPLCFLAGS= --min-size BENCH_FD=alpha bridge cars crypta digit8 donald eq10 eq20 five gardner magic\ multipl partit queens send square send srq magsq qg5 langford interval BENCH_BOOL=bdiag bdonald bpigeon bqueens bramsey bschur bsend .SUFFIXES: .SUFFIXES: .pl $(SUFFIXES) all: fd bool clean: rm-fd rm-bool rm -f *.exe fd: $(BENCH_FD) rm-fd: rm -f $(BENCH_FD) alpha: alpha.pl $(GPLC) $(GPLCFLAGS) -o alpha alpha.pl bridge: bridge.pl $(GPLC) $(GPLCFLAGS) -o bridge bridge.pl cars: cars.pl $(GPLC) $(GPLCFLAGS) -o cars cars.pl crypta: crypta.pl $(GPLC) $(GPLCFLAGS) -o crypta crypta.pl digit8: digit8.pl $(GPLC) $(GPLCFLAGS) -o digit8 digit8.pl donald: donald.pl $(GPLC) $(GPLCFLAGS) -o donald donald.pl eq10: eq10.pl $(GPLC) $(GPLCFLAGS) -o eq10 eq10.pl eq20: eq20.pl $(GPLC) $(GPLCFLAGS) -o eq20 eq20.pl five: five.pl $(GPLC) $(GPLCFLAGS) -o five five.pl gardner: gardner.pl $(GPLC) $(GPLCFLAGS) -o gardner gardner.pl partit: partit.pl $(GPLC) $(GPLCFLAGS) -o partit partit.pl magic: magic.pl $(GPLC) $(GPLCFLAGS) -o magic magic.pl multipl: multipl.pl $(GPLC) $(GPLCFLAGS) -o multipl multipl.pl queens: queens.pl queens_fd.fd $(GPLC) $(GPLCFLAGS) -o queens queens.pl queens_fd.fd send: send.pl $(GPLC) $(GPLCFLAGS) -o send send.pl square: square.pl $(GPLC) $(GPLCFLAGS) -o square square.pl srq: srq.pl $(GPLC) $(GPLCFLAGS) -o srq srq.pl magsq: magsq.pl $(GPLC) $(GPLCFLAGS) -o magsq magsq.pl qg5: qg5.pl $(GPLC) $(GPLCFLAGS) -o qg5 qg5.pl langford: langford.pl $(GPLC) $(GPLCFLAGS) -o langford langford.pl interval: interval.pl $(GPLC) $(GPLCFLAGS) -o interval interval.pl bool: $(BENCH_BOOL) rm-bool: rm -f $(BENCH_BOOL) bdiag: bdiag.pl array.pl $(GPLC) $(GPLCFLAGS) -o bdiag bdiag.pl bdonald: bdonald.pl array.pl $(GPLC) $(GPLCFLAGS) -o bdonald bdonald.pl bpigeon: bpigeon.pl array.pl $(GPLC) $(GPLCFLAGS) -o bpigeon bpigeon.pl bqueens: bqueens.pl array.pl $(GPLC) $(GPLCFLAGS) -o bqueens bqueens.pl bramsey: bramsey.pl array.pl $(GPLC) $(GPLCFLAGS) -o bramsey bramsey.pl bschur: bschur.pl array.pl $(GPLC) $(GPLCFLAGS) -o bschur bschur.pl bsend: bsend.pl array.pl $(GPLC) $(GPLCFLAGS) -o bsend bsend.pl gprolog-1.4.5/examples/ExamplesFD/alpha.pl0000644000175000017500000000614513021324543016555 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : alpha.pl */ /* Title : alphacipher */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* This problem comes from the news group rec.puzzle. */ /* The numbers 1 - 26 have been randomly assigned to the letters of the */ /* alphabet. The numbers beside each word are the total of the values */ /* assigned to the letters in the word. e.g for LYRE L,Y,R,E might equal */ /* 5,9,20 and 13 respectively or any other combination that add up to 47. */ /* Find the value of each letter under the equations: */ /* */ /* BALLET 45 GLEE 66 POLKA 59 SONG 61 */ /* CELLO 43 JAZZ 58 QUARTET 50 SOPRANO 82 */ /* CONCERT 74 LYRE 47 SAXOPHONE 134 THEME 72 */ /* FLUTE 30 OBOE 53 SCALE 51 VIOLIN 100 */ /* FUGUE 50 OPERA 65 SOLO 37 WALTZ 34 */ /* */ /* Solution: */ /* [A, B,C, D, E,F, G, H, I, J, K,L,M, N, O, P,Q, R, S,T,U, V,W, X, Y, Z] */ /* [5,13,9,16,20,4,24,21,25,17,23,2,8,12,10,19,7,11,15,3,1,26,6,22,14,18] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), alpha(LD, Lab), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. alpha(LD, Lab) :- fd_set_vector_max(26), LD = [A, B, C, _D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z], fd_all_different(LD), fd_domain(LD, 1, 26), B + A + L + L + E + T #= 45, C + E + L + L + O #= 43, C + O + N + C + E + R + T #= 74, F + L + U + T + E #= 30, F + U + G + U + E #= 50, G + L + E + E #= 66, J + A + Z + Z #= 58, L + Y + R + E #= 47, O + B + O + E #= 53, O + P + E + R + A #= 65, P + O + L + K + A #= 59, Q + U + A + R + T + E + T #= 50, S + A + X + O + P + H + O + N + E #= 134, S + C + A + L + E #= 51, S + O + L + O #= 37, S + O + N + G #= 61, S + O + P + R + A + N + O #= 82, T + H + E + M + E #= 72, V + I + O + L + I + N #= 100, W + A + L + T + Z #= 34, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bramsey.pl0000644000175000017500000001075413021324543017133 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bramsey.pl */ /* Title : ramsey problem */ /* Original Source: Daniel Diaz - INRIA France */ /* Greg Sidebottom - University of Vancouver Canada */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1993 */ /* */ /* Find a 3-colouring of a complete graph with N vertices such that there */ /* is no monochrome triangles. */ /* */ /* The graph is a half-matrix of edges. Example N=5: */ /* Graph=m(v(e12), */ /* v(e13, e23), */ /* v(e14, e24, e34), */ /* v(e15, e25, e35, e45)) an edge eij is 3 colors [C3,C2,C1] */ /* (resolution by line) */ /* */ /* There is a solution up to N=16, none for N>=17. */ /* Solution: */ /* N=5 */ /* m(v([0,0,1]), */ /* v([0,1,0],[0,0,1]), */ /* v([0,1,0],[0,0,1],[1,0,0]), */ /* v([1,0,0],[0,0,1],[0,1,0],[0,1,0])) */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), ramsey(N, Graph), statistics(runtime, [_, Y]), write(Graph), nl, write('time : '), write(Y), nl. ramsey(N, Mat) :- adj(N, Mat), triangles(N, Mat, Tris), label(Tris). triangles(N, Mat, Ts) :- trianglesI(0, N, Mat, Ts, []). trianglesI(I1, N, Mat, Ts1, Ts) :- I1 < N, !, I is I1 + 1, trianglesJI(I, I, N, Mat, Ts1, Ts2), trianglesI(I, N, Mat, Ts2, Ts). trianglesI(N, N, _Mat, Ts, Ts). trianglesJI(J1, I, N, Mat, Ts1, Ts) :- J1 < N, !, J is J1 + 1, trianglesKJI(J, J, I, N, Mat, Ts1, Ts2), trianglesJI(J, I, N, Mat, Ts2, Ts). trianglesJI(N, _I, N, _Mat, Ts, Ts). trianglesKJI(K1, J, I, N, Mat, [EIJ, EJK, EKI|Ts1], Ts) :- K1 < N, !, K is K1 + 1, edge(I, J, Mat, EIJ), edge(J, K, Mat, EJK), edge(I, K, Mat, EKI), polychrom(EIJ, EJK, EKI), trianglesKJI(K, J, I, N, Mat, Ts1, Ts). trianglesKJI(N, _J, _I, N, _Mat, Ts, Ts). polychrom([C13, C12, C11], [C23, C22, C21], [C33, C32, C31]) :- #\ (C13 #/\ C23 #/\ C33), #\ (C12 #/\ C22 #/\ C32), #\ (C11 #/\ C21 #/\ C31). % these interface to the tmat routines, the essentially map the matrix % so the diagonal can be used adj(N, Mat) :- N1 is N - 1, tmat(N1, Mat). % edge must be called with I < J % could make more general so it swaps arguments if I > J edge(I, J, Mat, EIJ) :- J1 is J - 1, tmatRef(J1, I, Mat, EIJ), ( var(EIJ) -> cstr_edge(EIJ) ; true ). tmat(N, Mat) :- functor(Mat, m, N), tvecs(N, Mat). tvecs(0, _Mat) :- !. tvecs(J, Mat) :- arg(J, Mat, Vec), functor(Vec, v, J), J1 is J - 1, tvecs(J1, Mat). % tmatRef must be called with I > J % could make more general so it swaps arguments if I < J tmatRef(I, J, Mat, MatIJ) :- arg(I, Mat, MatI), arg(J, MatI, MatIJ). label([]). label([A, B, C|L]) :- labeltri(A, B, C), label(L). labeltri(A, B, C) :- same_edge(A, B), fd_labeling(A), fd_labeling(C). labeltri(A, B, C) :- same_edge(A, C), fd_labeling(A), fd_labeling(B). labeltri(A, B, C) :- same_edge(B, C), fd_labeling(B), fd_labeling(A). labeltri(A, B, C) :- fd_labeling(C), diff_edge(A, C), diff_edge(B, C), fd_labeling(B), diff_edge(A, B). same_edge(Edge, Edge). diff_edge([C13, C12, C11], [C23, C22, C21]) :- #\ (C13 #/\ C23), #\ (C12 #/\ C22), #\ (C11 #/\ C21). cstr_edge(E) :- E = [_, _, _], fd_only_one(E). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/queens.pl0000644000175000017500000000431513021324543016765 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : queens.pl */ /* Title : N-queens problem */ /* Original Source: P. Van Hentenryck's book */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* Put N queens on an NxN chessboard so that there is no couple of queens */ /* threatening each other. */ /* */ /* Solution: */ /* N=4 [2,4,1,3] */ /* N=8 [1,5,8,6,3,7,2,4] */ /* N=16 [1,3,5,2,13,9,14,12,15,6,16,7,4,11,8,10] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), write('N ?'), read_integer(N), statistics(runtime, _), queens(N, L, Lab), statistics(runtime, [_, Y]), write(L), nl, write('time : '), write(Y), nl. queens(N, L, Lab) :- fd_set_vector_max(N), length(L, N), fd_domain(L, 1, N), safe(L), lab(Lab, L). safe([]). safe([X|L]) :- noattack(L, X, 1), safe(L). noattack([], _, _). noattack([Y|L],X,I):- I1 is I+1, noattack(L,X,I1), diff(X,Y,I). /* % slower version (term. rec) (original PVH's version) noattack([Y|L], X, I) :- diff(X, Y, I), I1 is I + 1, noattack(L, X, I1). */ diff(X, Y, I) :- fd_tell(diff(X, Y, I)). /* diff(X,Y,I):- X#\=Y, X#\=Y+I, X+I#\=Y. */ lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/magsq.pl0000644000175000017500000000504713021324543016600 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : magsq.pl */ /* Title : Magic square problem */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : July 1998 */ /* */ /* Fill square NxN with integers 1,2...N*N so that each line, each column */ /* and each diagonal has the same sum. */ /* threatening each other. */ /* */ /* Solution: */ /* N=3 [[4,9,2],[3,5,7],[8,1,6]] */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), magsq(N, A), statistics(runtime, [_, Y]), write(A), nl, write_array(A, '%5d', 0), write('time : '), write(Y), nl. magsq(N, A) :- create_array(N, N, A), N2 is N * N, fd_set_vector_max(N2), S is N * (N2 + 1) // 2, g_assign(s, S), g_assign(n, N), g_assign(n2, N2), array_values(A, Values), fd_all_different(Values), for_each_line(A, dom), for_each_line(A, sum), for_each_column(A, sum), for_each_big_diagonal(A, N, sum), array_elem(A, 1, 1, X11), array_elem(A, 1, N, X1N), array_elem(A, N, 1, XN1), array_elem(A, N, N, XNN), X11 #< X1N, % 4 symmetry breaking constraints X11 #< XN1, X11 #< XNN, XN1 #> X1N, for_each_big_diagonal(A, N, lab), % for_each_line(A,lab). fd_labeling(Values, [variable_method(ff), value_method(max)]). % in practice this random is better than max % fd_labeling(Values, [variable_method(ff), value_method(random)]). array_prog(dom, L) :- g_read(n2, N2), fd_domain(L, 1, N2). array_prog(sum, L) :- g_read(s, S), sum(L, S). array_prog(lab, L) :- fd_labeling(L, [value_method(middle)]). /* reorder(L,L1):- g_read(n,N), fd_domain(X,1,N), findall(V,(fd_labeling(X,[value_method(middle)]),nth(X,L,V)),L1). */ sum([], 0). sum([X|Xs], S) :- S #= X + S1, sum(Xs, S1). :- include(array). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/langford.pl0000644000175000017500000000652313021324543017264 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : langford.pl */ /* Title : Langford's problem */ /* Original Source: Daniel Diaz */ /* Date : February 2003 */ /* */ /* The problem L(K,N) is to arrange K sets of numbers 1 to N, so that each */ /* appearance of the number M is M numbers on from the last. We here solve */ /* L(2,N). The problem admits a solution if N is of the form 4k or 4k-1. */ /* */ /* Solution: */ /* N=4 [2,3,4,2,1,3,1,4] */ /* N=8 [1,5,1,6,4,7,8,5,3,4,6,2,3,7,2,8] */ /* N=11 [5,1,2,1,9,2,5,8,10,11,4,6,7,3,9,4,8,3,6,10,7,11] */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), langford(N, L), statistics(runtime, [_, Y]), write(L), nl, write('time : '), write(Y), nl. /* * Find an assignment of [X1, X2, ..., Xn] (Xi is the position of the first occurrence of i). * For each Xi the constraints are: * * Xi in 1..(N+N-1-i) * if each pair Xi, Xj (i < j) the following holds: * Xj != Xi * Xj != Xi + i + 1 * Xj != Xi - j - 1 * Xj != Xi + i - j * * This can be achieved using #=# in set_cstr (but slower at the end) * * Here we keep the list of positions Ui (resp. Vi) is the position of the first (resp. second) occurrence of i * It is possible to only keep one list (i.e. Ui) but seems slower (see file LANGFORD.pl) */ langford(N, LD) :- ( N mod 4 =:= 0 ; N mod 4 =:= 3 ), !, length(U, N), length(V, N), append(U, V, L), N2 is N * 2, fd_set_vector_max(N2), fd_domain(L, 1, N2), fd_all_different(L), set_cstr(U, V, 1), symetric(N, N2, L), % fd_labeling(U, [variable_method(random), value_method(random)]), % sometimes much better fd_labeling(U, [variable_method(ff), value_method(max)]), decode(U, N2, LD). /* * Find an assignment of [X1, X2, ..., Xn] (Xi is the position of the first occurrence of i). * For each Xi the constraints are: * * Xi in 1..(N+N-1-i) * if each pair Xi, Xj (i < j) the following holds: * Xi != Xj * Xj != Xi + i + 1 * Xi != Xj + j + 1 * Xi + i + 1 != Xj + j + 1 * * This can be achieved using #=# in set_cstr (but slower at the end) */ set_cstr([], [], _). set_cstr([X|U], [Y|V], I) :- I1 is I + 1, Y #= X + I1, % also avoid some symetries since enforces X < Y % Y #=# X + I1, % better pruning but slower for big values set_cstr(U, V, I1). symetric(N, N2, UV) :- fd_element_var(I1, UV, 1), fd_element_var(I2, UV, N2), I1 #=< I2 - N. decode(L, N2, LD) :- length(LD, N2), decode1(L, 1, LD). decode1([], _, _). decode1([X|L], I, LD) :- nth(X, LD, I), Y is X + I + 1, nth(Y, LD, I), I1 is I + 1, decode1(L, I1, LD). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/gardner.pl0000644000175000017500000001123113021324543017102 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : gardner.pl */ /* Title : Gardner's prime puzzle problem */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : February 1997 - modified May 2007 */ /* */ /* Solve the operation: */ /* */ /* mP where tP is a string of t prime digits (2,3,5 or 7) */ /* x nP */ /* -------- */ /* = (m+n)P */ /* */ /* Solution: */ /* */ /* M=1 N=1 */ /* [5,5,25] */ /* [5,7,35] */ /* [7,5,35] */ /* */ /* M=4 N=3 */ /* [3235,735,2377725] */ /* [3323,775,2575325] */ /* [3535,773,2732555] */ /* [3553,775,2753575] */ /* [3555,725,2577375] */ /* [3575,777,2777775] */ /* [3735,733,2737755] */ /* [3755,725,2722375] */ /* [5225,527,2753575] */ /* [7225,727,5252575] */ /* [7253,325,2357225] */ /* [7255,355,2575525] */ /* [7273,375,2727375] */ /* [7275,733,5332575] */ /* [7325,373,2732225] */ /* [7325,727,5325275] */ /* [7335,753,5523255] */ /* [7353,375,2757375] */ /* [7355,725,5332375] */ /* [7375,753,5553375] */ /* [7533,335,2523555] */ /* [7575,337,2552775] */ /* [7735,333,2575755] */ /* [7757,355,2753735] */ /* [7777,325,2527525] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), write('M ?'), read_integer(M), write('N ?'), read_integer(N), statistics(runtime, _), ( gardner(M, N, L, Lab), write(L), nl, fail ; true ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. gardner(M, N, L, Lab) :- MN is M + N, length(LX, M), length(LY, N), length(LZ, MN), nb(LX, X), nb(LY, Y), nb(LZ, Z), X * Y #= Z, L = [X, Y, Z], append(LX, LY, LXY), append(LXY, LZ, LXYZ), lab(Lab, LXYZ). nb(LX, X) :- fd_domain(LX, [2, 3, 5, 7]), nb(LX, 0, X). nb([], N, N). nb([X|L], I, N) :- I1 #= X + I * 10, nb(L, I1, N). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/cars.pl0000644000175000017500000001226213021324543016415 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : cars.pl */ /* Title : car sequencing problem */ /* Original Source: Dincbas, Simonis and Van Hentenryck */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* Car sequencing problem with 10 cars */ /* Solution: */ /* [1,2,6,3,5,4,4,5,3,6] */ /* [1,3,6,2,5,4,3,5,4,6] */ /* [1,3,6,2,6,4,5,3,4,5] */ /* [5,4,3,5,4,6,2,6,3,1] */ /* [6,3,5,4,4,5,3,6,2,1] */ /* [6,4,5,3,4,5,2,6,3,1] */ /* */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), ( cars(L, Lab), write(L), nl, fail ; true ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. cars(X, Lab) :- fd_set_vector_max(6), X = [X1, X2, X3, X4, X5, X6, X7, X8, X9, X10], Y = [O11, O12, O13, O14, O15, O21, O22, O23, O24, O25, O31, O32, O33, O34, O35, O41, O42, O43, O44, O45, O51, O52, O53, O54, O55, O61, O62, O63, O64, O65, O71, O72, O73, O74, O75, O81, O82, O83, O84, O85, O91, O92, O93, O94, O95, O101, O102, O103, O104, O105], L1 = [1, 0, 0, 0, 1, 1], L2 = [0, 0, 1, 1, 0, 1], L3 = [1, 0, 0, 0, 1, 0], L4 = [1, 1, 0, 1, 0, 0], L5 = [0, 0, 1, 0, 0, 0], fd_domain(Y, 0, 1), fd_domain(X, 1, 6), fd_atmost(1, X, 1), fd_atmost(1, X, 2), fd_atmost(2, X, 3), fd_atmost(2, X, 4), fd_atmost(2, X, 5), fd_atmost(2, X, 6), fd_element(X1, L1, O11), fd_element(X1, L2, O12), fd_element(X1, L3, O13), fd_element(X1, L4, O14), fd_element(X1, L5, O15), fd_element(X2, L1, O21), fd_element(X2, L2, O22), fd_element(X2, L3, O23), fd_element(X2, L4, O24), fd_element(X2, L5, O25), fd_element(X3, L1, O31), fd_element(X3, L2, O32), fd_element(X3, L3, O33), fd_element(X3, L4, O34), fd_element(X3, L5, O35), fd_element(X4, L1, O41), fd_element(X4, L2, O42), fd_element(X4, L3, O43), fd_element(X4, L4, O44), fd_element(X4, L5, O45), fd_element(X5, L1, O51), fd_element(X5, L2, O52), fd_element(X5, L3, O53), fd_element(X5, L4, O54), fd_element(X5, L5, O55), fd_element(X6, L1, O61), fd_element(X6, L2, O62), fd_element(X6, L3, O63), fd_element(X6, L4, O64), fd_element(X6, L5, O65), fd_element(X7, L1, O71), fd_element(X7, L2, O72), fd_element(X7, L3, O73), fd_element(X7, L4, O74), fd_element(X7, L5, O75), fd_element(X8, L1, O81), fd_element(X8, L2, O82), fd_element(X8, L3, O83), fd_element(X8, L4, O84), fd_element(X8, L5, O85), fd_element(X9, L1, O91), fd_element(X9, L2, O92), fd_element(X9, L3, O93), fd_element(X9, L4, O94), fd_element(X9, L5, O95), fd_element(X10, L1, O101), fd_element(X10, L2, O102), fd_element(X10, L3, O103), fd_element(X10, L4, O104), fd_element(X10, L5, O105), 1 #>= O11 + O21, 1 #>= O21 + O31, 1 #>= O31 + O41, 1 #>= O41 + O51, 1 #>= O51 + O61, 1 #>= O61 + O71, 1 #>= O71 + O81, 1 #>= O81 + O91, 1 #>= O91 + O101, 2 #>= O12 + O22 + O32, 2 #>= O22 + O32 + O42, 2 #>= O32 + O42 + O52, 2 #>= O42 + O52 + O62, 2 #>= O52 + O62 + O72, 2 #>= O62 + O72 + O82, 2 #>= O72 + O82 + O92, 2 #>= O82 + O92 + O102, 1 #>= O13 + O23 + O33, 1 #>= O23 + O33 + O43, 1 #>= O33 + O43 + O53, 1 #>= O43 + O53 + O63, 1 #>= O53 + O63 + O73, 1 #>= O63 + O73 + O83, 1 #>= O73 + O83 + O93, 1 #>= O83 + O93 + O103, 2 #>= O14 + O24 + O34 + O44 + O54, 2 #>= O24 + O34 + O44 + O54 + O64, 2 #>= O34 + O44 + O54 + O64 + O74, 2 #>= O44 + O54 + O64 + O74 + O84, 2 #>= O54 + O64 + O74 + O84 + O94, 2 #>= O64 + O74 + O84 + O94 + O104, 1 #>= O15 + O25 + O35 + O45 + O55, 1 #>= O25 + O35 + O45 + O55 + O65, 1 #>= O35 + O45 + O55 + O65 + O75, 1 #>= O45 + O55 + O65 + O75 + O85, 1 #>= O55 + O65 + O75 + O85 + O95, 1 #>= O65 + O75 + O85 + O95 + O105, % redundant constraints O11 + O21 + O31 + O41 + O51 + O61 + O71 + O81 #>= 4, O11 + O21 + O31 + O41 + O51 + O61 #>= 3, O11 + O21 + O31 + O41 #>= 2, O11 + O21 #>= 1, O12 + O22 + O32 + O42 + O52 + O62 + O72 #>= 4, O12 + O22 + O32 + O42 #>= 2, O12 #>= 0, O13 + O23 + O33 + O43 + O53 + O63 + O73 #>= 2, O13 + O23 + O33 + O43 #>= 1, O13 #>= 0, O14 + O24 + O34 + O44 + O54 #>= 2, O15 + O25 + O35 + O45 + O55 #>= 1, lab(Lab, X). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/array.pl0000644000175000017500000001056613021324543016610 0ustar spaspa /* Array procedures */ /*---------------------------------------------------------* * An array NL x NC elements is represented as follows : * * A = [L_1, ..., L_NL] with L_i = [X_i_1, ..., X_i_NC] * * Hence : * * A = [ [X_1_1,..., X_1_NC], ..., [X_NL_1,..., X_NL_NC] ] * *---------------------------------------------------------*/ % create_array(+NL, +NC, ?A): creates an array (with unbound variables) % NL: nb of lines NC:nb of columns A:array create_array(NL, NC, A) :- create_array1(0, NL, NC, A), !. create_array1(NL, NL, _, []). create_array1(I, NL, NC, [L|A]) :- create_one_line(0, NC, L), I1 is I + 1, create_array1(I1, NL, NC, A). create_one_line(NC, NC, []). create_one_line(J, NC, [_|L]) :- J1 is J + 1, create_one_line(J1, NC, L). % array_elem(+A, +I, +J, ?X): returns an element % A:array I: line no J: column no X: the element array_elem(A, I, J, X) :- nth1(I, A, L), nth1(J, L, X). % array_values(+A, ?Values): returns all elements % A: array Values: list of elements array_values([], []). array_values([L|A], Values) :- array_values(A, V), append(L, V, Values). % array_line(+A, +I, ?C): returns the Ith line % A:array I: line no L: the line array_line(A, I, L) :- nth1(I, A, L). % array_column(+A, +J, ?C): returns the Jth column % A:array J: column no C: the column array_column([], _, []). array_column([L|A], J, [X|C]) :- nth1(J, L, X), array_column(A, J, C). % for_each_line(+A, +P): invokes a user procedure for each line % A:array P: program term % calls: array_prog(P, L) for each line L (L is a list) for_each_line([], _). for_each_line([L|A], P) :- array_prog(P, L), for_each_line(A, P). % for_each_column(+A, +P): invokes a user procedure for each column % A:array P: program term % calls: array_prog(P, L) for each column L (L is a list) for_each_column([[]|_], _) :- !. for_each_column(A, P) :- create_column(A, C, A1), array_prog(P, C), for_each_column(A1, P). create_column([], [], []). create_column([[X|L]|A], [X|C], [L|A1]) :- create_column(A, C, A1). % for_each_diagonal(+A, +NL, +NC, +P): invokes a user procedure for each diagonal % A:array NL: nb of lines % NC:nb of columns P: program term % calls: array_prog(P, D) for each diagonal D (D is a list) for_each_diagonal(A, NL, NC, P) :- NbDiag is 2 * (NL + NC - 1), % numbered from 0 to NbDiag-1 create_lst_diagonal(0, NbDiag, LD), fill_lst_diagonal(A, 0, NL, NC, LD, LD1), !, for_each_line(LD1, P). create_lst_diagonal(NbDiag, NbDiag, []). create_lst_diagonal(I, NbDiag, [[]|LD]) :- I1 is I + 1, create_lst_diagonal(I1, NbDiag, LD). fill_lst_diagonal([], _, _, _, LD, LD). fill_lst_diagonal([L|A], I, NL, NC, LD, LD2) :- I1 is I + 1, fill_lst_diagonal(A, I1, NL, NC, LD, LD1), one_list(L, I, NL, 0, NC, LD1, LD2). one_list([], _, _, _, _, LD, LD). one_list([X|L], I, NL, J, NC, LD, LD3) :- J1 is J + 1, one_list(L, I, NL, J1, NC, LD, LD1), NoDiag1 is I + J, NoDiag2 is I + NC - J + NL + NC - 2, add_in_lst_diagonal(0, NoDiag1, X, LD1, LD2), add_in_lst_diagonal(0, NoDiag2, X, LD2, LD3). add_in_lst_diagonal(NoDiag, NoDiag, X, [D|LD], [[X|D]|LD]). add_in_lst_diagonal(K, NoDiag, X, [D|LD], [D|LD1]) :- K1 is K + 1, add_in_lst_diagonal(K1, NoDiag, X, LD, LD1). % for_each_big_diagonal(+A, +N, +P): invokes a user procedure for each major diagonal % A:array N: nb of lines/columns (must be a square) % P: program term % calls: array_prog(P, D) for each diagonal D (D is a list) for_each_big_diagonal(A, N, P) :- big_diags(A, 0, N, D1, D2), array_prog(P, D1), array_prog(P, D2). big_diags([], _, _, [], []). big_diags([L|A], I, J, [X|D1], [Y|D2]) :- I1 is I + 1, J1 is J - 1, nth1(I1, L, X), nth1(J, L, Y), big_diags(A, I1, J1, D1, D2). % write_array(+A, +Format, +Sep): writes an array % A:array Format: format for element writing % Sep: nb of spaces between 2 elements of a line write_array([], _, _). write_array([L|A], Format, Sep) :- write_array_line(L, Format, Sep), nl, write_array(A, Format, Sep). write_array_line([], _, _). write_array_line([X|L], Format, Sep) :- format(Format, [X]), tab(Sep), write_array_line(L, Format, Sep). % array_labeling(+A): call fd_labeling line by line % A:array array_labeling([]). array_labeling([L|A]) :- fd_labeling(L), array_labeling(A). gprolog-1.4.5/examples/ExamplesFD/digit8.pl0000644000175000017500000000417113021324543016655 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : digit8.pl */ /* Title : particular 8 digit number */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : October 1993 */ /* */ /* Find the 8 digit number N such that: */ /* */ /* - N is a square */ /* - if we put a 1 in front of the decimal notation of N then it is */ /* still a square */ /* */ /* Solution: */ /* [N,X,M,Y] */ /* [23765625,4875,123765625,11125] */ /* [56250000,7500,156250000,12500] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), ( digit8(L, Lab), write(L), nl, fail ; write('No more solutions'), nl ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. digit8(L, Lab) :- L = [N, X, M, Y], N #>= 10000000, N #=< 99999999, X ** 2 #= N, 100000000 + N #= M, Y ** 2 #= M, lab(Lab, L). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/magic.pl0000644000175000017500000000662013021324543016546 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : magic.pl */ /* Title : magic series */ /* Original Source: W.J. Older and F. Benhamou - Programming in CLP(BNR) */ /* (in Position Papers of PPCP'93) */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : May 1993 */ /* */ /* A magic serie is a sequence x0, x1, ..., xN-1 such that each xi is the */ /* number of occurences of i in the serie. */ /* N-1 */ /* ie xi = Sum (xj=i) where (xj=i) is 1 if x=y and 0 if x<>y */ /* i=0 */ /* */ /* two redundant constraints are used: */ /* N-1 N-1 */ /* Sum i = N and Sum i*xi = N */ /* i=0 i=0 */ /* */ /* Note: in the Pascal's original version the length of a magic serie is */ /* N+1 (x0, x1, ..., XN) instead of N (x0, x1, ..., xN-1). Finding such a */ /* serie (for N) only corresponds to find a serie for N+1 in this version. */ /* Also the original version only used one redundant constraint. */ /* */ /* Solution: */ /* N=1,2,3 and 6 none */ /* N=4 [1,2,1,0] and [2,0,2,0] */ /* N=5 [2,1,2,0,0] */ /* N=7 [3,2,1,1,0,0,0] (for N>=7 [N-4,2,1,,1,0,0,0]) */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), write('N ?'), read_integer(N), statistics(runtime, _), magic(N, L, Lab), statistics(runtime, [_, Y]), write(L), nl, write('time : '), write(Y), nl. magic(N, L, Lab) :- fd_set_vector_max(N), length(L, N), fd_domain(L, 0, N), constraints(L, L, 0, N, N), lab(Lab, L). constraints([], _, _, 0, 0). constraints([X|Xs], L, I, S, S2) :- sum(L, I, X), I1 is I + 1, S1 + X #= S, % redundant constraint 1 ( I = 0 -> S3 = S2 ; I * X + S3 #= S2 ), % redundant constraint 2 constraints(Xs, L, I1, S1, S3). sum([], _, 0). sum([X|Xs], I, S) :- sum(Xs, I, S1), X #= I #<=> B, S #= B + S1. lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/.gitignore0000644000175000017500000000042613021324543017117 0ustar spaspaTO_DO BENCHING RES_C* COMPARE_BENCH* BENCH_NAMES* LANGFORD.PL SUDOKU.PL GOLOMB.PL CHECK.sh alpha bdiag bdonald bpigeon bqueens bramsey bridge bschur bsend cars crypta digit8 donald eq10 eq20 five gardner interval langford magic magsq multipl partit qg5 queens send square srq gprolog-1.4.5/examples/ExamplesFD/bqueens.pl0000644000175000017500000000552113021324543017127 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bqueens.pl */ /* Title : N-queens problem */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* Put N queens on an NxN chessboard so that there is no couple of queens */ /* threatening each other. */ /* The solution is a list [ [Que11,...,Que1N], ... ,[QueN1,...,QueNN] ] */ /* where Queij is 1 if the the is a queen on the ith line an jth row. */ /* */ /* Solution: */ /* N=4 [[0,0,1,0], [[0,1,0,0], */ /* [1,0,0,0], [0,0,0,1], */ /* [0,0,0,1], and [1,0,0,0], */ /* [0,1,0,0]] [0,0,1,0]] */ /* */ /* N=8 [[0,0,0,0,0,0,0,1], (first solution) */ /* [0,0,0,1,0,0,0,0], */ /* [1,0,0,0,0,0,0,0], */ /* [0,0,1,0,0,0,0,0], */ /* [0,0,0,0,0,1,0,0], */ /* [0,1,0,0,0,0,0,0], */ /* [0,0,0,0,0,0,1,0], */ /* [0,0,0,0,1,0,0,0]] */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), ( bqueens(N, A), write(A), nl %, % fail ; write('No more solutions'), nl ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. bqueens(N, A) :- create_array(N, N, A), for_each_line(A, only1), for_each_column(A, only1), for_each_diagonal(A, N, N, atmost1), !, array_labeling(A). :- include(array). % interface with for_each_... procedures array_prog(only1, L) :- fd_only_one(L). array_prog(atmost1, L) :- fd_at_most_one(L). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/donald.pl0000644000175000017500000000464613021324543016735 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : donald.pl */ /* Title : crypt-arithmetic */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* Solve the operation: */ /* */ /* D O N A L D */ /* + G E R A L D */ /* -------------- */ /* = R O B E R T */ /* */ /* (resolution by line) */ /* */ /* Solution: */ /* [D,O,N,A,L,G,E,R,B,T] */ /* [5,2,6,4,8,1,9,7,3,0] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), donald(LD, Lab), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. donald(LD, Lab) :- fd_set_vector_max(9), LD = [D, O, N, A, L, G, E, R, B, T], fd_all_different(LD), fd_domain(LD, 0, 9), fd_domain([D, G], 1, 9), 100000 * D + 10000 * O + 1000 * N + 100 * A + 10 * L + D + 100000 * G + 10000 * E + 1000 * R + 100 * A + 10 * L + D #= 100000 * R + 10000 * O + 1000 * B + 100 * E + 10 * R + T, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/interval.pl0000644000175000017500000000500613021324543017307 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : all-interval.pl */ /* Title : all-interval series problem */ /* Original Source: */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : May 2009 */ /* */ /* Find sequence of N different values in 0 .. N-1 such that the distance */ /* between 2 consecutive values are all distinct. */ /* */ /* NB: there is an obvious solution: 0 N-1 1 N-2 N N-3 */ /* this solution is found without backtracking with a labeling on distances*/ /* enumerating variables from their max to the min (see labeling on LD) */ /* For other solutions, remove this labeling. */ /* */ /* Solution: */ /* N=8 [1,7,0,5,2,6,4,3] */ /* N=14 [1,13,0,11,2,12,4,10,3,8,5,9,7,6] */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), statistics(runtime, _), interval(N, L), statistics(runtime, [_, Y]), write(L), nl, write('time : '), write(Y), nl. interval(N, L) :- N1 is N - 1, fd_set_vector_max(N), length(L, N), fd_domain(L, 0, N1), L = [X|L1], mk_dist(L1, X, LD), fd_domain(LD, 1, N1), fd_all_different(L), fd_all_different(LD), % avoid mirror symmetry L = [X, Y|_], X #< Y, X #> 0, % avoid dual solution (symmetry) LD = [D1|_], last(LD, D2), D1 #> D2, % the labeling of LD speeds up a lot if just the first solution is wanted (else remove it) fd_labeling(LD, [value_method(max), backtracks(_B)]), %write(_B), nl, % the labeling (useless if only the first solution is wanted, labeling of LD is enough) fd_labeling(L, [variable_method(ff), value_method(middle)]). mk_dist([], _, []). mk_dist([Y|L], X, [D|LD]) :- D #= dist(X, Y), mk_dist(L, Y, LD). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bpigeon.pl0000644000175000017500000000435713021324543017116 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bpigeon.pl */ /* Title : pigeon-hole problem */ /* Originated from: */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : January 1993 */ /* */ /* Put N pigeons in M pigeon-holes. Solution iff N<=M. */ /* The solution is a list [ [Pig11,...,Pig1m], ... ,[Pign1,...,Pignm] ] */ /* where Pigij = 1 if the pigeon i is in the pigeon-hole j */ /* */ /* Solution: */ /* N=2 M=3 [[0,0,1],[0,1,0]] */ /* [[0,0,1],[1,0,0]] */ /* [[0,1,0],[0,0,1]] */ /* [[0,1,0],[1,0,0]] */ /* [[1,0,0],[0,0,1]] */ /* [[1,0,0],[0,1,0]] */ /*-------------------------------------------------------------------------*/ q :- write('N ?'), read_integer(N), write('M ?'), read_integer(M), statistics(runtime, _), g_assign(count, 0), ( bpigeon(N, M, _A), % write(_A), nl, g_inc(count), fail ; g_read(count, Count), format('Number of solutions ~d~n', [Count]) ), statistics(runtime, [_, Y]), write('time : '), write(Y), nl. bpigeon(N, M, A) :- create_array(N, M, A), for_each_line(A, only1), for_each_column(A, atmost1), !, array_labeling(A). :- include(array). % interface with for_each_... procedures array_prog(only1, L) :- fd_only_one(L). array_prog(atmost1, L) :- fd_at_most_one(L). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/eq10.pl0000644000175000017500000000524313021324543016234 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : eq10.pl */ /* Title : linear equations */ /* Original Source: Thomson LCR */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* A system involving 7 variables and 10 equations */ /* */ /* Solution: */ /* [X1,X2,X3,X4,X5,X6,X7] */ /* [ 6, 0, 8, 4, 9, 3, 9] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), eq10(LD, Lab), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. eq10(LD, Lab) :- LD = [X1, X2, X3, X4, X5, X6, X7], fd_domain(LD, 0, 10), 0 + 98527 * X1 + 34588 * X2 + 5872 * X3 + 59422 * X5 + 65159 * X7 #= 1547604 + 30704 * X4 + 29649 * X6, 0 + 98957 * X2 + 83634 * X3 + 69966 * X4 + 62038 * X5 + 37164 * X6 + 85413 * X7 #= 1823553 + 93989 * X1, 900032 + 10949 * X1 + 77761 * X2 + 67052 * X5 #= 0 + 80197 * X3 + 61944 * X4 + 92964 * X6 + 44550 * X7, 0 + 73947 * X1 + 84391 * X3 + 81310 * X5 #= 1164380 + 96253 * X2 + 44247 * X4 + 70582 * X6 + 33054 * X7, 0 + 13057 * X3 + 42253 * X4 + 77527 * X5 + 96552 * X7 #= 1185471 + 60152 * X1 + 21103 * X2 + 97932 * X6, 1394152 + 66920 * X1 + 55679 * X4 #= 0 + 64234 * X2 + 65337 * X3 + 45581 * X5 + 67707 * X6 + 98038 * X7, 0 + 68550 * X1 + 27886 * X2 + 31716 * X3 + 73597 * X4 + 38835 * X7 #= 279091 + 88963 * X5 + 76391 * X6, 0 + 76132 * X2 + 71860 * X3 + 22770 * X4 + 68211 * X5 + 78587 * X6 #= 480923 + 48224 * X1 + 82817 * X7, 519878 + 94198 * X2 + 87234 * X3 + 37498 * X4 #= 0 + 71583 * X1 + 25728 * X5 + 25495 * X6 + 70023 * X7, 361921 + 78693 * X1 + 38592 * X5 + 38478 * X6 #= 0 + 94129 * X2 + 43188 * X3 + 82528 * X4 + 69025 * X7, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/five.pl0000644000175000017500000000516513021324543016422 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : five.pl */ /* Title : five house puzzle */ /* Original Source: P. Van Hentenryck's book */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* A logic puzzle */ /* */ /* Solution: */ /* [N1,N2,N3,N4,N5, [3,4,5,2,1, */ /* C1,C2,C3,C4,C5, 5,3,1,2,4, */ /* P1,P2,P3,P4,P5, 5,1,4,2,3, */ /* A1,A2,A3,A4,A5, 4,5,1,3,2, */ /* D1,D2,D3,D4,D5] 4,1,2,5,3] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), five_house(L, Lab), statistics(runtime, [_, Y]), write(L), nl, write('time : '), write(Y), nl. five_house(L, Lab) :- fd_set_vector_max(5), L = [N1, N2, N3, N4, N5, C1, C2, C3, C4, C5, P1, P2, P3, P4, P5, A1, A2, A3, A4, A5, D1, D2, D3, D4, D5], fd_domain(L, 1, 5), N5 #= 1, D5 #= 3, fd_all_different([C1, C2, C3, C4, C5]), fd_all_different([P1, P2, P3, P4, P5]), fd_all_different([N1, N2, N3, N4, N5]), fd_all_different([A1, A2, A3, A4, A5]), fd_all_different([D1, D2, D3, D4, D5]), N1 #= C2, N2 #= A1, N3 #= P1, N4 #= D3, P3 #= D1, C1 #= D4, P5 #= A4, P2 #= C3, C1 #= C5 + 1, plus_or_minus(A3, P4, 1), plus_or_minus(A5, P2, 1), plus_or_minus(N5, C4, 1), % lab(Lab,L). % faster than lab(Lab,[C1,...,D5]) lab(Lab, [C1, C2, C3, C4, C5, P1, P2, P3, P4, P5, N1, N2, N3, N4, N5, A1, A2, A3, A4, A5, D1, D2, D3, D4, D5]). % partial lookahead plus_or_minus(X, Y, C) :- X #= Y + C. plus_or_minus(X, Y, C) :- X + C #= Y. lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/srq.pl0000644000175000017500000001441013021324543016267 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) INRIA Rocquencourt - ChLoE Project */ /* */ /* Name : srq.pl */ /* Title : Self-Referential Quiz puzzle */ /* Original Source: M. Henz */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : February 1997 */ /* */ /* */ /* Q1 : the first question whose answer is A is */ /* (A) 4 (B) 3 (C) 2 (D) 1 (E) none of the above */ /* Q2 : the only two consecutive questions with identical answers are */ /* (A) 3 and 4 (B) 4 and 5 (C) 5 and 6 (D) 6 and 7 (E) 7 and 8*/ /* Q3 : the next question with answer A is */ /* (A) 4 (B) 5 (C) 6 (D) 7 (E) 8 */ /* Q4 : the first even numbered question with answer B is */ /* (A) 2 (B) 4 (C) 6 (D) 8 (E) 10 */ /* Q5 : the only odd numbered question with answer C is */ /* (A) 1 (B) 3 (C) 5 (D) 7 (E) 9 */ /* Q6 : a question with answer D */ /* (A) comes before this one but not after this one */ /* (B) comes after this one but not before this one */ /* (C) comes before and after this one */ /* (D) does not occur at all */ /* (E) none of the above */ /* Q7 : the last question whose answer is E is */ /* (A) 5 (B) 6 (C) 7 (D) 8 (E) 9 */ /* Q8 : the number of questions whose answers are conconants is */ /* (A) 7 (B) 6 (C) 5 (D) 4 (E) 3 */ /* Q9 : the number of questions whose answers are vowels is */ /* (A) 0 (B) 1 (C) 2 (D) 3 (E) 4 */ /* Q10: the answer of this question is */ /* (A) A (B) B (C) C (D) D (E) E */ /* */ /* Solution: */ /* [3,1,2,2,1,2,5,2,5,4] */ /* C,A,B,B,A,B,E,B,E,D */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), srq(L, Lab), statistics(runtime, [_, Y]), write(L), nl, write('time : '), write(Y), nl. srq(L, Lab) :- L = [Q1, Q2, Q3, Q4, Q5, Q6, Q7, Q8, Q9, Q10], fd_domain(L, 1, 5), Q1 #= 1 #<=> Q4 #= 1 #/\ Q1 #\= 1 #/\ Q2 #\= 1 #/\ Q3 #\= 1, Q1 #= 2 #<=> Q3 #= 1 #/\ Q1 #\= 1 #/\ Q2 #\= 1, Q1 #= 3 #<=> Q2 #= 1 #/\ Q1 #\= 1, Q1 #= 4 #<=> Q1 #= 1, % Q1#=5 #<=> Q1#\=1 #/\ Q2#\=1 #/\ Q3#\=1 #/\ Q4#\=1, Q2 #= 1 #<=> Q3 #= Q4, Q2 #= 2 #<=> Q4 #= Q5, Q2 #= 3 #<=> Q5 #= Q6, Q2 #= 4 #<=> Q6 #= Q7, Q2 #= 5 #<=> Q7 #= Q8, Q3 #= 1 #<=> Q4 #= 1, Q3 #= 2 #<=> Q5 #= 1 #/\ Q4 #\= 1, Q3 #= 3 #<=> Q6 #= 1 #/\ Q4 #\= 1 #/\ Q5 #\= 1, Q3 #= 4 #<=> Q7 #= 1 #/\ Q4 #\= 1 #/\ Q5 #\= 1 #/\ Q6 #\= 1, Q3 #= 5 #<=> Q8 #= 1 #/\ Q4 #\= 1 #/\ Q5 #\= 1 #/\ Q6 #\= 1 #/\ Q7 #\= 1, Q4 #= 1 #<=> Q2 #= 2, Q4 #= 2 #<=> Q4 #= 2 #/\ Q2 #\= 2, Q4 #= 3 #<=> Q6 #= 2 #/\ Q2 #\= 2 #/\ Q4 #\= 2, Q4 #= 4 #<=> Q8 #= 2 #/\ Q2 #\= 2 #/\ Q4 #\= 2 #/\ Q6 #\= 2, Q4 #= 5 #<=> Q10 #= 2 #/\ Q2 #\= 2 #/\ Q4 #\= 2 #/\ Q6 #\= 2 #/\ Q8 #\= 2, Q5 #= 1 #<=> Q1 #= 3 #/\ Q3 #\= 3 #/\ Q5 #\= 3 #/\ Q7 #\= 3 #/\ Q9 #\= 3, Q5 #= 2 #<=> Q3 #= 3 #/\ Q1 #\= 3 #/\ Q5 #\= 3 #/\ Q7 #\= 3 #/\ Q9 #\= 3, Q5 #= 3 #<=> Q5 #= 3 #/\ Q1 #\= 3 #/\ Q3 #\= 3 #/\ Q7 #\= 3 #/\ Q9 #\= 3, Q5 #= 4 #<=> Q7 #= 3 #/\ Q1 #\= 3 #/\ Q2 #\= 3 #/\ Q5 #\= 3 #/\ Q9 #\= 3, Q5 #= 5 #<=> Q9 #= 3 #/\ Q1 #\= 3 #/\ Q3 #\= 3 #/\ Q5 #\= 3 #/\ Q7 #\= 3, BeforeQ4 #<=> Q1 #= 4 #\/ Q2 #= 4 #\/ Q3 #= 4 #\/ Q4 #= 4 #\/ Q5 #= 4, AfterQ4 #<=> Q7 #= 4 #\/ Q8 #= 4 #\/ Q9 #= 4 #\/ Q10 #= 4, Q6 #= 1 #<=> BeforeQ4 #/\ #\ AfterQ4, Q6 #= 2 #<=> #\ BeforeQ4 #/\ AfterQ4, Q6 #= 3 #<=> BeforeQ4 #/\ AfterQ4, Q6 #= 4 #<=> Q1 #\= 4 #/\ Q2 #\= 4 #/\ Q3 #\= 4 #/\ Q4 #\= 4 #/\ Q5 #\= 4 #/\ Q6 #\= 4 #/\ Q7 #\= 4 #/\ Q8 #\= 4 #/\ Q9 #\= 4 #/\ Q10 #\= 4, % Q6#=5 #<=> Q6#=4, Q7 #= 1 #<=> Q5 #= 5 #/\ Q6 #\= 5 #/\ Q7 #\= 5 #/\ Q8 #\= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5, Q7 #= 2 #<=> Q6 #= 5 #/\ Q7 #\= 5 #/\ Q8 #\= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5, Q7 #= 3 #<=> Q7 #= 5 #/\ Q8 #\= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5, Q7 #= 4 #<=> Q8 #= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5, Q7 #= 5 #<=> Q9 #= 5 #/\ Q10 #\= 5, BCD1 #<=> Q1 #>= 2 #/\ Q1 #=< 4, AE1 #<=> #\ BCD1, BCD2 #<=> Q2 #>= 2 #/\ Q2 #=< 4, AE2 #<=> #\ BCD2, BCD3 #<=> Q3 #>= 2 #/\ Q3 #=< 4, AE3 #<=> #\ BCD3, BCD4 #<=> Q4 #>= 2 #/\ Q4 #=< 4, AE4 #<=> #\ BCD4, BCD5 #<=> Q5 #>= 2 #/\ Q5 #=< 4, AE5 #<=> #\ BCD5, BCD6 #<=> Q6 #>= 2 #/\ Q6 #=< 4, AE6 #<=> #\ BCD6, BCD7 #<=> Q7 #>= 2 #/\ Q7 #=< 4, AE7 #<=> #\ BCD7, BCD8 #<=> Q8 #>= 2 #/\ Q8 #=< 4, AE8 #<=> #\ BCD8, BCD9 #<=> Q9 #>= 2 #/\ Q9 #=< 4, AE9 #<=> #\ BCD9, BCD10 #<=> Q10 #>= 2 #/\ Q10 #=< 4, AE10 #<=> #\ BCD10, BCD #= BCD1 + BCD2 + BCD3 + BCD4 + BCD5 + BCD6 + BCD7 + BCD8 + BCD9 + BCD10, AE #= AE1 + AE2 + AE3 + AE4 + AE5 + AE6 + AE7 + AE8 + AE9 + AE10, Q8 #= 1 #<=> BCD #= 7, Q8 #= 2 #<=> BCD #= 6, Q8 #= 3 #<=> BCD #= 5, Q8 #= 4 #<=> BCD #= 4, Q8 #= 5 #<=> BCD #= 3, Q9 #= 1 #<=> AE #= 0, Q9 #= 2 #<=> AE #= 1, Q9 #= 3 #<=> AE #= 2, Q9 #= 4 #<=> AE #= 3, Q9 #= 5 #<=> AE #= 4, lab(Lab, L). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bdiag.pl0000644000175000017500000001007213021324543016530 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Boolean) */ /* */ /* Name : bdiag.pl */ /* Title : N adder diagnostic */ /* Original Source: Greg Sidebottom - University of Vancouver Canada */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1993 */ /* */ /* The circuit diagnosis problem is as follows: */ /* */ /*Given: */ /* 1. a description of a digital circuit with a set of components C */ /* 2. a function f computed by the circuit */ /* 3. a symptom consisting of an input output pair (i,o) such that */ /* f(i) <> o */ /* Find: */ /* a diagnosis D. D is a subset of C which, if not working correctly, */ /* could result in the circuit computing o given i. */ /* */ /* The specific circuit used for this benchmark is an N bit adder with */ /* forward carry propagation. However, any combinatorial circuit diagnosis*/ /* problem could easily formulated from it's network description. */ /* This example was constructed based on an example from an article about */ /* Prolog III in CACM July 1990. */ /* The problem consists in finding the minimum number of broken components */ /* in a N bit adder that thinks 0+0=2^N-1 (the answer is always N). */ /* Each adder consists of 5 gates (2 'and', 2 'xor' and 1 'or'). */ /* A boolean (Di) is associated to each gate and it is true (1) if the */ /* gate is broken. The solution is a list of Di. F is the number of broken */ /* components. To minimize F we label it (indomain) first (since there is */ /* no choice point it is correct). */ /* */ /* Solution: */ /* N=1 [0,0,0,0,1] */ /* N=2 [0,0,0,0,1,0,0,0,0,1] */ /* N=3 [0,0,0,0,1,0,0,0,0,1,0,0,0,0,1] */ /*-------------------------------------------------------------------------*/ q :- statistics(runtime, _), write('N ?'), read_integer(N), Z is 1 << N - 1, bdiag(N, 0, 0, Z, 0, 0, Ds, F), statistics(runtime, [_, Y]), write(s(F, Ds)), nl, write('time : '), write(Y), nl. bdiag(N, X, Y, Z, C1, C, Ds, F) :- N5 is N * 5, F #=< N5, nadder(N, X, Y, Z, C1, C, Ds), TN is 1 << N, X + Y + C1 #\= Z + TN * C, sum(Ds, F), fd_minimize(fd_labeling(Ds), F). % fd_labeling([F|Ds]). sum([], 0). sum([X|Xs], S) :- S #= X + S1, sum(Xs, S1). nadder(N, X, Y, Z, C1, C, Ds) :- bits(N, X, Xs), bits(N, Y, Ys), bits(N, Z, Zs), adder(Xs, Ys, Zs, C1, C, Ds). bits(N, X, Xs) :- length(Xs, N), bits1(Xs, 0, N, X). bits1([], N, N, 0). bits1([Xi|Xs1], I, N, X) :- I < N, X #= Xi * 2 ** I + X1, I1 is I + 1, bits1(Xs1, I1, N, X1). adder([], [], [], C, C, []). adder([X|Xs], [Y|Ys], [Z|Zs], C1, C, [D0, D1, D2, D3, D4|Ds]) :- fullAdder(X, Y, C1, Z, C2, D0, D1, D2, D3, D4), adder(Xs, Ys, Zs, C2, C, Ds). fullAdder(X, Y, C1, Z, C, D0, D1, D2, D3, D4) :- #\ D0 #==> (U1 #<=> X #/\ Y), #\ D1 #==> (U2 #<=> U3 #/\ C1), #\ D2 #==> (C #<=> U1 #\/ U2), #\ D3 #==> (U3 #<=> X ## Y), #\ D4 #==> (Z #<=> U3 ## C1). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/multipl.pl0000644000175000017500000000650513021324543017156 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : multipl.pl */ /* Title : unknown multiplication */ /* Original Source: Daniel Diaz - INRIA France */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : June 1995 */ /* */ /* Find the value of each digit verifying the following multiplication and */ /* such that each digit (0,1,...,9) appears excatly twice: */ /* */ /* X1 X2 X3 */ /* * X4 X5 X6 */ /* ----------- */ /* X7 X8 X9 */ /* + X10 X11 X12 */ /* + X13 X14 X15 */ /* = ------------------- */ /* X16 X17 X18 X19 X20 */ /* */ /* Solution: */ /* [X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18,X19,X20]*/ /* [ 1, 7, 9, 2, 2, 4, 7, 1, 6, 3, 5, 8, 3, 5, 8, 4, 0, 0, 9, 6]*/ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), mult(Lab, LD), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. mult(Lab, LD) :- fd_set_vector_max(9), LD = [X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15, X16, X17, X18, X19, X20], fd_domain(LD, 0, 9), fd_atmost(2, LD, 0), fd_atmost(2, LD, 1), fd_atmost(2, LD, 2), fd_atmost(2, LD, 3), fd_atmost(2, LD, 4), fd_atmost(2, LD, 5), fd_atmost(2, LD, 6), fd_atmost(2, LD, 7), fd_atmost(2, LD, 8), fd_atmost(2, LD, 9), /* This is much slower... fd_exactly(2,LD,0), fd_exactly(2,LD,1), fd_exactly(2,LD,2), fd_exactly(2,LD,3), fd_exactly(2,LD,4), fd_exactly(2,LD,5), fd_exactly(2,LD,6), fd_exactly(2,LD,7), fd_exactly(2,LD,8), fd_exactly(2,LD,9), */ Y #= 100 * X1 + 10 * X2 + X3, Z1 #= 100 * X7 + 10 * X8 + X9, Z2 #= 100 * X10 + 10 * X11 + X12, Z3 #= 100 * X13 + 10 * X14 + X15, X6 * Y #= Z1, X5 * Y #= Z2, X4 * Y #= Z3, 100 * X7 + 10 * X8 + X9 + 1000 * X10 + 100 * X11 + 10 * X12 + 10000 * X13 + 1000 * X14 + 100 * X15 #= 10000 * X16 + 1000 * X17 + 100 * X18 + 10 * X19 + X20, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bridge.pl0000644000175000017500000001514413021324543016723 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : bridge.pl */ /* Title : bridge scheduling problem */ /* Original Source: P. Van Hentenryck's book and */ /* COSYTEC (version used in "Overview of a CHIP Compiler")*/ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : October 1994 */ /* */ /* Find a scheduling that minimizes the time to build a 5-segment bridge. */ /* */ /* Solution: */ /* */ /* Optimal (End=104) */ /* */ /* [[start,0,0],[a1,4,3],[a2,2,13],[a3,2,7],[a4,2,15],[a5,2,1],[a6,5,38], */ /* [p1,20,9],[p2,13,29],[ue,10,0],[s1,8,10],[s2,4,18],[s3,4,29],[s4,4,42],*/ /* [s5,4,6],[s6,10,46],[b1,1,18],[b2,1,22],[b3,1,33],[b4,1,46],[b5,1,10], */ /* [b6,1,56],[ab1,1,19],[ab2,1,23],[ab3,1,34],[ab4,1,47],[ab5,1,11], */ /* [ab6,1,57],[m1,16,20],[m2,8,36],[m3,8,44],[m4,8,52],[m5,8,12], */ /* [m6,20,60],[l1,2,30],[t1,12,44],[t2,12,56],[t3,12,68],[t4,12,92], */ /* [t5,12,80],[ua,10,78],[v1,15,56],[v2,10,92],[k1,0,42],[k2,0,80], */ /* [stop,0,104]] */ /*-------------------------------------------------------------------------*/ q :- statistics(runtime, _), bridge(Ld, End), statistics(runtime, [_, Y]), write(Ld), nl, write(End), nl, write('time : '), write(Y), nl. bridge(K, Ende) :- setup(K, Ende, Disj), fd_minimize(choice(Disj, K), Ende). setup(K, Ende, Disj) :- jobs(L), make_vars(L, K), member([stop, _, Ende], K), precedence(M), make_precedence(M, K), max_nf(M1), make_max_nf(M1, K), max_ef(M2), make_max_ef(M2, K), min_af(M3), make_min_af(M3, K), min_sf(M4), make_min_sf(M4, K), min_nf(M5), make_min_nf(M5, K), resources(R), make_disj(R, K, [], Disj1), reverse(Disj1, Disj). choice(Disj, K) :- disjunct(Disj), label(K). make_vars([], []). make_vars([H|T], [[H, D, A]|R]) :- duration(H, D), fd_domain(A, 0, 200), make_vars(T, R). make_precedence([], _). make_precedence([[A, B]|R], L) :- member([A, Ad, Aa], L), member([B, _Bd, Ba], L), Ba #>= Aa + Ad, make_precedence(R, L). make_max_nf([], _). make_max_nf([[A, B, C]|R], L) :- member([A, Ad, Aa], L), member([B, _Bd, Ba], L), C1 is C + Ad, Ba #=< Aa + C1, make_max_nf(R, L). make_max_ef([], _). make_max_ef([[A, B, C]|R], L) :- member([A, Ad, Aa], L), member([B, Bd, Ba], L), C1 is Ad + C - Bd, Ba #=< Aa + C1, make_max_ef(R, L). make_min_af([], _). make_min_af([[A, B, C]|R], L) :- member([A, _Ad, Aa], L), member([B, _Bd, Ba], L), Ba #>= Aa + C, make_min_af(R, L). make_min_sf([], _). make_min_sf([[A, B, C]|R], L) :- member([A, _Ad, Aa], L), member([B, Bd, Ba], L), C1 is C - Bd, Ba #=< Aa + C1, make_min_sf(R, L). make_min_nf([], _). make_min_nf([[A, B, C]|R], L) :- member([A, Ad, _Aa], L), member([B, _Bd, Ba], L), C1 is C + Ad, Ba #>= Ad + C1, make_min_nf(R, L). make_disj([], _R, D, D). make_disj([[_H, R]|T], K, Din, Dout) :- el_list(R, K, R1), make_disj1(R1, Din, D1), make_disj(T, K, D1, Dout). make_disj1([], D, D). make_disj1([H|T], Din, Dout) :- make_disj2(H, T, Din, D1), make_disj1(T, D1, Dout). make_disj2(_H, [], D, D). make_disj2([A, B], [[C, D]|S], Din, Dout) :- make_disj2([A, B], S, [[A, B, C, D]|Din], Dout). el_list([], _, []). el_list([H|T], L, [[A, D]|S]) :- member([H, D, A], L), el_list(T, L, S). disjunct([]). disjunct([[A, B, C, D]|R]) :- disj(A, B, C, D), disjunct(R). disj(Aa, Ad, Ba, _Bd) :- Ba #>= Aa + Ad. disj(Aa, _Ad, Ba, Bd) :- Aa #>= Ba + Bd. label([]). label([[_A, _Ad, Aa]|R]) :- fd_labeling(Aa), label(R). /* DATA */ jobs([start, a1, a2, a3, a4, a5, a6, p1, p2, ue, s1, s2, s3, s4, s5, s6, b1, b2, b3, b4, b5, b6, ab1, ab2, ab3, ab4, ab5, ab6, m1, m2, m3, m4, m5, m6, l1, t1, t2, t3, t4, t5, ua, v1, v2, k1, k2, stop]). duration(start, 0). duration(a1, 4). duration(a2, 2). duration(a3, 2). duration(a4, 2). duration(a5, 2). duration(a6, 5). duration(p1, 20). duration(p2, 13). duration(ue, 10). duration(s1, 8). duration(s2, 4). duration(s3, 4). duration(s4, 4). duration(s5, 4). duration(s6, 10). duration(b1, 1). duration(b2, 1). duration(b3, 1). duration(b4, 1). duration(b5, 1). duration(b6, 1). duration(ab1, 1). duration(ab2, 1). duration(ab3, 1). duration(ab4, 1). duration(ab5, 1). duration(ab6, 1). duration(m1, 16). duration(m2, 8). duration(m3, 8). duration(m4, 8). duration(m5, 8). duration(m6, 20). duration(l1, 2). duration(t1, 12). duration(t2, 12). duration(t3, 12). duration(t4, 12). duration(t5, 12). duration(ua, 10). duration(v1, 15). duration(v2, 10). duration(k1, 0). duration(k2, 0). duration(stop, 0). precedence([[start, a1], [start, a2], [start, a3], [start, a4], [start, a5], [start, a6], [start, ue], [a1, s1], [a2, s2], [a5, s5], [a6, s6], [a3, p1], [a4, p2], [p1, s3], [p2, s4], [p1, k1], [p2, k1], [s1, b1], [s2, b2], [s3, b3], [s4, b4], [s5, b5], [s6, b6], [b1, ab1], [b2, ab2], [b3, ab3], [b4, ab4], [b5, ab5], [b6, ab6], [ab1, m1], [ab2, m2], [ab3, m3], [ab4, m4], [ab5, m5], [ab6, m6], [m1, t1], [m2, t1], [m2, t2], [m3, t2], [m3, t3], [m4, t3], [m4, t4], [m5, t4], [m5, t5], [m6, t5], [m1, k2], [m2, k2], [m3, k2], [m4, k2], [m5, k2], [m6, k2], [l1, t1], [l1, t2], [l1, t3], [l1, t4], [l1, t5], [t1, v1], [t5, v2], [t2, stop], [t3, stop], [t4, stop], [v1, stop], [v2, stop], [ua, stop], [k1, stop], [k2, stop]]). max_nf([[start, l1, 30], [a1, s1, 3], [a2, s2, 3], [a5, s5, 3], [a6, s6, 3], [p1, s3, 3], [p2, s4, 3]]). min_sf([[ua, m1, 2], [ua, m2, 2], [ua, m3, 2], [ua, m4, 2], [ua, m5, 2], [ua, m6, 2]]). max_ef([[s1, b1, 4], [s2, b2, 4], [s3, b3, 4], [s4, b4, 4], [s5, b5, 4], [s6, b6, 4]]). min_nf([[start, l1, 30]]). min_af([[ue, s1, 6], [ue, s2, 6], [ue, s3, 6], [ue, s4, 6], [ue, s5, 6], [ue, s6, 6]]). resources([[crane, [l1, t1, t2, t3, t4, t5]], [bricklaying, [m1, m2, m3, m4, m5, m6]], [schal, [s1, s2, s3, s4, s5, s6]], [excavator, [a1, a2, a3, a4, a5, a6]], [ram, [p1, p2]], [pump, [b1, b2, b3, b4, b5, b6]], [caterpillar, [v1, v2]]]). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/send.pl0000644000175000017500000000450613021324543016420 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : send.pl */ /* Title : crypt-arithmetic */ /* Original Source: P. Van Hentenryck's book */ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : September 1992 */ /* */ /* Solve the operation: */ /* */ /* S E N D */ /* + M O R E */ /* ----------- */ /* = M O N E Y */ /* */ /* (resolution by line) */ /* */ /* Solution: */ /* [S,E,N,D,M,O,R,Y] */ /* [9,5,6,7,1,0,8,2] */ /*-------------------------------------------------------------------------*/ q :- get_fd_labeling(Lab), statistics(runtime, _), send(LD, Lab), statistics(runtime, [_, Y]), write(LD), nl, write('time : '), write(Y), nl. send(LD, Lab) :- LD = [S, E, N, D, M, O, R, Y], fd_all_different(LD), fd_domain(LD, 0, 9), fd_domain([S, M], 1, 9), 1000 * S + 100 * E + 10 * N + D + 1000 * M + 100 * O + 10 * R + E #= 10000 * M + 1000 * O + 100 * N + 10 * E + Y, lab(Lab, LD). lab(normal, L) :- fd_labeling(L). lab(ff, L) :- fd_labelingff(L). get_fd_labeling(Lab) :- argument_counter(C), get_labeling1(C, Lab). get_labeling1(1, normal). get_labeling1(2, Lab) :- argument_value(1, Lab). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/bridge1.pl0000644000175000017500000001632313021324543017004 0ustar spaspa/*-------------------------------------------------------------------------*/ /* Benchmark (Finite Domain) */ /* */ /* Name : bridge.pl */ /* Title : bridge scheduling problem */ /* Original Source: P. Van Hentenryck's book and */ /* COSYTEC (version used in "Overview of a CHIP Compiler")*/ /* Adapted by : Daniel Diaz for GNU Prolog */ /* Date : October 1994 */ /* */ /* Find a scheduling that minimizes the time to build a 5-segment bridge. */ /* */ /* Solution: */ /* */ /* Optimal (End=104) */ /* */ /* [[start,0,0],[a1,4,3],[a2,2,13],[a3,2,7],[a4,2,15],[a5,2,1],[a6,5,38], */ /* [p1,20,9],[p2,13,29],[ue,10,0],[s1,8,10],[s2,4,18],[s3,4,29],[s4,4,42],*/ /* [s5,4,6],[s6,10,46],[b1,1,18],[b2,1,22],[b3,1,33],[b4,1,46],[b5,1,10], */ /* [b6,1,56],[ab1,1,19],[ab2,1,23],[ab3,1,34],[ab4,1,47],[ab5,1,11], */ /* [ab6,1,57],[m1,16,20],[m2,8,36],[m3,8,44],[m4,8,52],[m5,8,12], */ /* [m6,20,60],[l1,2,30],[t1,12,44],[t2,12,56],[t3,12,68],[t4,12,92], */ /* [t5,12,80],[ua,10,78],[v1,15,56],[v2,10,92],[k1,0,42],[k2,0,80], */ /* [stop,0,104]] */ /*-------------------------------------------------------------------------*/ /* constraint definitions */ smallereqc(X, Y, C) :- % X #=< Y+C. fd_tell(x_plus_c_gte_y(Y, C, X)). greatereqc(X, Y, C) :- % X #>= Y+C. fd_tell(x_plus_c_lte_y(Y, C, X)). q :- statistics(runtime, _), bridge(Ld, End), statistics(runtime, [_, Y]), write(Ld), nl, write(End), nl, write('time : '), write(Y), nl. bridge(K, Ende) :- setup(K, Ende, Disj), fd_minimize(choice(Disj, K), Ende). setup(K, Ende, Disj) :- jobs(L), make_vars(L, K), member([stop, _, Ende], K), precedence(M), make_precedence(M, K), max_nf(M1), make_max_nf(M1, K), max_ef(M2), make_max_ef(M2, K), min_af(M3), make_min_af(M3, K), min_sf(M4), make_min_sf(M4, K), min_nf(M5), make_min_nf(M5, K), resources(R), make_disj(R, K, [], Disj1), reverse(Disj1, Disj). choice(Disj, K) :- disjunct(Disj), label(K). make_vars([], []). make_vars([H|T], [[H, D, A]|R]) :- duration(H, D), fd_domain(A, 0, 200), make_vars(T, R). make_precedence([], _). make_precedence([[A, B]|R], L) :- member([A, Ad, Aa], L), member([B, _Bd, Ba], L), greatereqc(Ba, Aa, Ad), % Ba #>= Aa+Ad, make_precedence(R, L). make_max_nf([], _). make_max_nf([[A, B, C]|R], L) :- member([A, Ad, Aa], L), member([B, _Bd, Ba], L), C1 is C + Ad, smallereqc(Ba, Aa, C1), % Ba #=< Aa+C1, make_max_nf(R, L). make_max_ef([], _). make_max_ef([[A, B, C]|R], L) :- member([A, Ad, Aa], L), member([B, Bd, Ba], L), C1 is Ad + C - Bd, smallereqc(Ba, Aa, C1), % Ba #=< Aa+C1, make_max_ef(R, L). make_min_af([], _). make_min_af([[A, B, C]|R], L) :- member([A, _Ad, Aa], L), member([B, _Bd, Ba], L), greatereqc(Ba, Aa, C), % Ba #>= Aa+C, make_min_af(R, L). make_min_sf([], _). make_min_sf([[A, B, C]|R], L) :- member([A, _Ad, Aa], L), member([B, Bd, Ba], L), C1 is C - Bd, smallereqc(Ba, Aa, C1), % Ba #=< Aa+C1, make_min_sf(R, L). make_min_nf([], _). make_min_nf([[A, B, C]|R], L) :- member([A, Ad, _Aa], L), member([B, _Bd, Ba], L), C1 is C + Ad, greatereqc(Ba, Ad, C1), % Ba #>= Ad+C1, make_min_nf(R, L). make_disj([], _R, D, D). make_disj([[_H, R]|T], K, Din, Dout) :- el_list(R, K, R1), make_disj1(R1, Din, D1), make_disj(T, K, D1, Dout). make_disj1([], D, D). make_disj1([H|T], Din, Dout) :- make_disj2(H, T, Din, D1), make_disj1(T, D1, Dout). make_disj2(_H, [], D, D). make_disj2([A, B], [[C, D]|S], Din, Dout) :- make_disj2([A, B], S, [[A, B, C, D]|Din], Dout). el_list([], _, []). el_list([H|T], L, [[A, D]|S]) :- member([H, D, A], L), el_list(T, L, S). disjunct([]). disjunct([[A, B, C, D]|R]) :- disj(A, B, C, D), disjunct(R). disj(Aa, Ad, Ba, _Bd) :- greatereqc(Ba, Aa, Ad). % Ba #>= Aa+Ad. disj(Aa, _Ad, Ba, Bd) :- greatereqc(Aa, Ba, Bd). % Aa #>= Ba+Bd. label([]). label([[_A, _Ad, Aa]|R]) :- fd_labeling(Aa), label(R). /* DATA */ jobs([start, a1, a2, a3, a4, a5, a6, p1, p2, ue, s1, s2, s3, s4, s5, s6, b1, b2, b3, b4, b5, b6, ab1, ab2, ab3, ab4, ab5, ab6, m1, m2, m3, m4, m5, m6, l1, t1, t2, t3, t4, t5, ua, v1, v2, k1, k2, stop]). duration(start, 0). duration(a1, 4). duration(a2, 2). duration(a3, 2). duration(a4, 2). duration(a5, 2). duration(a6, 5). duration(p1, 20). duration(p2, 13). duration(ue, 10). duration(s1, 8). duration(s2, 4). duration(s3, 4). duration(s4, 4). duration(s5, 4). duration(s6, 10). duration(b1, 1). duration(b2, 1). duration(b3, 1). duration(b4, 1). duration(b5, 1). duration(b6, 1). duration(ab1, 1). duration(ab2, 1). duration(ab3, 1). duration(ab4, 1). duration(ab5, 1). duration(ab6, 1). duration(m1, 16). duration(m2, 8). duration(m3, 8). duration(m4, 8). duration(m5, 8). duration(m6, 20). duration(l1, 2). duration(t1, 12). duration(t2, 12). duration(t3, 12). duration(t4, 12). duration(t5, 12). duration(ua, 10). duration(v1, 15). duration(v2, 10). duration(k1, 0). duration(k2, 0). duration(stop, 0). precedence([[start, a1], [start, a2], [start, a3], [start, a4], [start, a5], [start, a6], [start, ue], [a1, s1], [a2, s2], [a5, s5], [a6, s6], [a3, p1], [a4, p2], [p1, s3], [p2, s4], [p1, k1], [p2, k1], [s1, b1], [s2, b2], [s3, b3], [s4, b4], [s5, b5], [s6, b6], [b1, ab1], [b2, ab2], [b3, ab3], [b4, ab4], [b5, ab5], [b6, ab6], [ab1, m1], [ab2, m2], [ab3, m3], [ab4, m4], [ab5, m5], [ab6, m6], [m1, t1], [m2, t1], [m2, t2], [m3, t2], [m3, t3], [m4, t3], [m4, t4], [m5, t4], [m5, t5], [m6, t5], [m1, k2], [m2, k2], [m3, k2], [m4, k2], [m5, k2], [m6, k2], [l1, t1], [l1, t2], [l1, t3], [l1, t4], [l1, t5], [t1, v1], [t5, v2], [t2, stop], [t3, stop], [t4, stop], [v1, stop], [v2, stop], [ua, stop], [k2, stop]]). max_nf([[start, l1, 30], [a1, s1, 3], [a2, s2, 3], [a5, s5, 3], [a6, s6, 3], [p1, s3, 3], [p2, s4, 3]]). min_sf([[ua, m1, 2], [ua, m2, 2], [ua, m3, 2], [ua, m4, 2], [ua, m5, 2], [ua, m6, 2]]). max_ef([[s1, b1, 4], [s2, b2, 4], [s3, b3, 4], [s4, b4, 4], [s5, b5, 4], [s6, b6, 4]]). min_nf([[start, l1, 30]]). min_af([[ue, s1, 6], [ue, s2, 6], [ue, s3, 6], [ue, s4, 6], [ue, s5, 6], [ue, s6, 6]]). resources([[crane, [l1, t1, t2, t3, t4, t5]], [bricklaying, [m1, m2, m3, m4, m5, m6]], [schal, [s1, s2, s3, s4, s5, s6]], [excavator, [a1, a2, a3, a4, a5, a6]], [ram, [p1, p2]], [pump, [b1, b2, b3, b4, b5, b6]], [caterpillar, [v1, v2]]]). :- initialization(q). gprolog-1.4.5/examples/ExamplesFD/queens_fd.fd0000644000175000017500000000015513021324543017412 0ustar spaspadiff(fdv X,fdv Y,int I) { start X in ~{val(Y),val(Y)+I,val(Y)-I} start Y in ~{val(X),val(X)+I,val(X)-I} } gprolog-1.4.5/examples/ExamplesPl/0000755000175000017500000000000013021324543015207 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/hook.pl0000644000175000017500000000035513021324543016507 0ustar spaspa% hook file for GNU Prolog % Count is passed on the command line as the 1st argument get_count(Count) :- argument_value(1, ACount), number_atom(Count, ACount). get_cpu_time(T) :- statistics(runtime, [T, _]). :- initialization(q). gprolog-1.4.5/examples/ExamplesPl/reducer.pl0000644000175000017500000002664713021324543017214 0ustar spaspa%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % A Graph Reducer for T-Combinators: % Reduces a T-combinator expression to a final answer. Recognizes % the combinators I,K,S,B,C,S',B',C', cond, apply, arithmetic, tests, % basic list operations, and function definitions in the data base stored % as facts of the form t_def(_func, _args, _expr). % Written by Peter Van Roy % Uses write/1, compare/3, functor/3, arg/3. reducer(ShowResult) :- try(fac(3), _ans1), (ShowResult = true -> write(_ans1), nl ; true), try(quick([3,1,2]), _ans2), (ShowResult = true -> write(_ans2), nl ; true). try(_inpexpr, _anslist) :- listify(_inpexpr, _list), curry(_list, _curry), t_reduce(_curry, _ans), % nl, make_list(_ans, _anslist). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Examples of applicative functions which can be compiled & executed. % This test version compiles them just before each execution. % Factorial function: t_def(fac, [N], cond(N=0, 1, N*fac(N-1))). % Quicksort: t_def(quick, [_l], cond(_l=[], [], cond(tl(_l)=[], _l, quick2(split(hd(_l),tl(_l)))))). t_def(quick2, [_l], append(quick(hd(_l)), quick(tl(_l)))). t_def(split, [_e,_l], cond(_l=[], [[_e]|[]], cond(hd(_l)=<_e, inserthead(hd(_l),split(_e,tl(_l))), inserttail(hd(_l),split(_e,tl(_l)))))). t_def(inserthead, [_e,_l], [[_e|hd(_l)]|tl(_l)]). t_def(inserttail, [_e,_l], [hd(_l)|[_e|tl(_l)]]). t_def(append, [_a,_b], cond(_a=[], _b, [hd(_a)|append(tl(_a),_b)])). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Full reduction: % A dot '.' is printed for each reduction step. t_reduce(_expr, _ans) :- atomic(_expr), !, _ans=_expr. % The reduction of '.' must be here to avoid an infinite loop t_reduce([_y,_x|'.'], [_yr,_xr|'.']) :- t_reduce(_x, _xr), !, t_reduce(_y, _yr), !. t_reduce(_expr, _ans) :- t_append(_next, _red, _form, _expr), % write('.'), t_redex(_form, _red), !, t_reduce(_next, _ans), !. t_append(_link, _link, _l, _l). t_append([_a|_l1], _link, _l2, [_a|_l3]) :- t_append(_l1, _link, _l2, _l3). % One step of the reduction: % Combinators: t_redex([_x,_g,_f,_k|sp], [[_xr|_g],[_xr|_f]|_k]) :- t_reduce(_x, _xr). t_redex([_x,_g,_f,_k|bp], [[_x|_g],_f|_k]). t_redex([_x,_g,_f,_k|cp], [_g,[_x|_f]|_k]). t_redex([_x,_g,_f|s], [[_xr|_g]|[_xr|_f]]) :- t_reduce(_x, _xr). t_redex([_x,_g,_f|b], [[_x|_g]|_f]). t_redex([_x,_g,_f|c], [_g,_x|_f]). t_redex([_y,_x|k], _x). t_redex([_x|i], _x). % Conditional: t_redex([_elsepart,_ifpart,_cond|cond], _ifpart) :- t_reduce(_cond, _bool), _bool=true, !. % Does NOT work if _bool is substituted in the call! t_redex([_elsepart,_ifpart,_cond|cond], _elsepart). % Apply: t_redex([_f|apply], _fr) :- t_reduce(_f, _fr). % List operations: t_redex([_arg|hd], _x) :- t_reduce(_arg, [_y,_x|'.']). t_redex([_arg|tl], _y) :- t_reduce(_arg, [_y,_x|'.']). % Arithmetic: t_redex([_y,_x|_op], _res) :- atom(_op), member(_op, ['+', '-', '*', '//', 'mod']), t_reduce(_x, _xres), t_reduce(_y, _yres), number(_xres), number(_yres), eval(_op, _res, _xres, _yres). % Tests: t_redex([_y,_x|_test], _res) :- atom(_test), member(_test, ['<', '>', '=<', '>=', '=\\=', '=:=']), t_reduce(_x, _xres), t_reduce(_y, _yres), number(_xres), number(_yres), (relop(_test, _xres, _yres) -> _res=true ; _res=false ), !. % Equality: t_redex([_y,_x|=], _res) :- t_reduce(_x, _xres), t_reduce(_y, _yres), (_xres=_yres -> _res=true; _res=false), !. % Arithmetic functions: t_redex([_x|_op], _res) :- atom(_op), member(_op, ['-']), t_reduce(_x, _xres), number(_xres), eval1(_op, _t, _xres). % Definitions: % Assumes a fact t_def(_func,_def) in the database for every % defined function. t_redex(_in, _out) :- append(_par,_func,_in), atom(_func), t_def(_func, _args, _expr), t(_args, _expr, _def), append(_par,_def,_out). % Basic arithmetic and relational operators: eval( '+', C, A, B) :- C is A + B. eval( '-', C, A, B) :- C is A - B. eval( '*', C, A, B) :- C is A * B. eval( '//', C, A, B) :- C is A // B. eval('mod', C, A, B) :- C is A mod B. eval1('-', C, A) :- C is -A. relop( '<', A, B) :- A', A, B) :- A>B. relop( '=<', A, B) :- A==', A, B) :- A>=B. relop('=\\=', A, B) :- A=\=B. relop('=:=', A, B) :- A=:=B. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Scheme T: % A Translation Scheme for T-Combinators % Translate an expression to combinator form % by abstracting out all variables in _argvars: t(_argvars, _expr, _trans) :- listify(_expr, _list), curry(_list, _curry), t_argvars(_argvars, _curry, _trans), !. t_argvars([], _trans, _trans). t_argvars([_x|_argvars], _in, _trans) :- t_argvars(_argvars, _in, _mid), t_vars(_mid, _vars), % calculate variables in each subexpression t_trans(_x, _mid, _vars, _trans). % main translation routine % Curry the original expression: % This converts an applicative expression of any number % of arguments and any depth of nesting into an expression % where all functions are curried, i.e. all function % applications are to one argument and have the form % [_arg|_func] where _func & _arg are also of that form. % Input is a nested function application in list form. % Currying makes t_trans faster. curry(_a, _a) :- (var(_a); atomic(_a)), !. curry([_func|_args], _cargs) :- currylist(_args, _cargs, _func). % Transform [_a1, ..., _aN] to [_cN, ..., _c1|_link]-_link currylist([], _link, _link) :- !. currylist([_a|_args], _cargs, _link) :- curry(_a, _c), currylist(_args, _cargs, [_c|_link]). % Calculate variables in each subexpression: % To any expression a list of the form % [_vexpr, _astr, _fstr] is matched. % If the expression is a variable or an atom % then this list only has the first element. % _vexpr = List of all variables in the expression. % _astr, _fstr = Similar structures for argument & function. t_vars(_v, [[_v]]) :- var(_v), !. t_vars(_a, [[]]) :- atomic(_a), !. t_vars([_func], [[]]) :- atomic(_func), !. t_vars([_arg|_func], [_g,[_g1|_af1],[_g2|_af2]]) :- t_vars(_arg, [_g1|_af1]), t_vars(_func, [_g2|_af2]), unionv(_g1, _g2, _g). % The main translation routine: % trans(_var, _curriedexpr, _varexpr, _result) % The translation scheme T in the article is followed literally. % A good example of Prolog as a specification language. t_trans(_x, _a, _, [_a|k]) :- (atomic(_a); var(_a), _a\==_x), !. t_trans(_x, _y, _, i) :- _x==_y, !. t_trans(_x, _e, [_ve|_], [_e|k]) :- notinv(_x, _ve). t_trans(_x, [_f|_e], [_vef,_sf,_se], _res) :- _sf=[_vf|_], _se=[_ve|_other], (atom(_e); _other=[_,[_ve1|_]], _ve1\==[]), t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, _res). t_trans(_x, [_g|[_f|_e]], [_vefg,_sg,_sef], _res) :- _sg=[_vg|_], _sef=[_vef,_sf,_se], _se=[_ve|_], _sf=[_vf|_], t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, _res). % First complex rule of translation scheme T: t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, _e) :- notinv(_x, _ve), _x==_f, !. t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, [_resf,_e|b]) :- notinv(_x, _ve), inv(_x, _vf), _x\==_f, !, t_trans(_x, _f, _sf, _resf). t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, [_f,_rese|c]) :- /* inv(_x, _ve), */ notinv(_x, _vf), !, t_trans(_x, _e, _se, _rese). t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, [_resf,_rese|s]) :- /* inv(_x, _ve), inv(_x, _vf), */ t_trans(_x, _e, _se, _rese), t_trans(_x, _f, _sf, _resf). % Second complex rule of translation scheme T: t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_g,_e|c]) :- _x==_f, notinv(_x, _vg), !. t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_resg,_e|s]) :- _x==_f, /* inv(_x, _vg), */ !, t_trans(_x, _g, _sg, _resg). t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_g,_resf,_e|cp]) :- /* _x\==_f, */ inv(_x, _vf), notinv(_x, _vg), !, t_trans(_x, _f, _sf, _resf). t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_resg,_resf,_e|sp]) :- /* _x\==_f, */ inv(_x, _vf), /* inv(_x, _vg), */ !, t_trans(_x, _f, _sf, _resf), t_trans(_x, _g, _sg, _resg). t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_f|_e]) :- /* notinv(_x, _vf), */ _x==_g, !. t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_resg,_f,_e|bp]) :- /* notinv(_x, _vf), inv(_x, _vg), _x\==_g, */ t_trans(_x, _g, _sg, _resg). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % List utilities: % Convert curried list into a regular list: make_list(_a, _a) :- atomic(_a). make_list([_b,_a|'.'], [_a|_rb]) :- make_list(_b, _rb). listify(_X, _X) :- (var(_X); atomic(_X)), !. listify(_Expr, [_Op|_LArgs]) :- functor(_Expr, _Op, N), listify_list(1, N, _Expr, _LArgs). listify_list(I, N, _, []) :- I>N, !. listify_list(I, N, _Expr, [_LA|_LArgs]) :- I=, A, S1, _, S2, S) :- intersectv_2(S2, A, S1, S). intersectv_list([], []). intersectv_list([InS|Sets], OutS) :- intersectv_list(Sets, InS, OutS). /* without DCG */ intersectv_list([], A, A). intersectv_list([A|B], C, D) :- intersectv(A, C, E), intersectv_list(B, E, D). /* PB to compile DCG with CIAO in our general environment intersectv_list([]) --> []. intersectv_list([S|Sets]) --> intersectv(S), intersectv_list(Sets). */ % *** Difference diffv([], _, []). diffv([A|S1], S2, S) :- diffv_2(S2, A, S1, S). diffv_2([], A, S1, [A|S1]). diffv_2([B|S2], A, S1, S) :- compare(Order, A, B), diffv_3(Order, A, S1, B, S2, S). diffv_3(<, A, S1, B, S2, [A|S]) :- diffv(S1, [B|S2], S). diffv_3(=, _A, S1, _, S2, S) :- diffv(S1, S2, S). diffv_3(>, A, S1, _, S2, S) :- diffv_2(S2, A, S1, S). % *** Union unionv([], S2, S2). unionv([A|S1], S2, S) :- unionv_2(S2, A, S1, S). unionv_2([], A, S1, [A|S1]). unionv_2([B|S2], A, S1, S) :- compare(Order, A, B), unionv_3(Order, A, S1, B, S2, S). unionv_3(<, A, S1, B, S2, [A|S]) :- unionv_2(S1, B, S2, S). unionv_3(=, A, S1, _, S2, [A|S]) :- unionv(S1, S2, S). unionv_3(>, A, S1, B, S2, [B|S]) :- unionv_2(S2, A, S1, S). % *** Subset subsetv([], _). subsetv([A|S1], [B|S2]) :- compare(Order, A, B), subsetv_2(Order, A, S1, S2). subsetv_2(=, _, S1, S2) :- subsetv(S1, S2). subsetv_2(>, A, S1, S2) :- subsetv([A|S1], S2). % For unordered lists S1: small_subsetv([], _). small_subsetv([A|S1], S2) :- inv(A, S2), small_subsetv(S1, S2). % *** Membership inv(A, [B|S]) :- compare(Order, A, B), inv_2(Order, A, S). inv_2(=, _, _). inv_2(>, A, S) :- inv(A, S). % *** Non-membership notinv(A, S) :- notinv_2(S, A). notinv_2([], _). notinv_2([B|S], A) :- compare(Order, A, B), notinv_3(Order, A, S). notinv_3(<, _, _). notinv_3(>, A, S) :- notinv_2(S, A). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % benchmark interface benchmark(ShowResult) :- reducer(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/CIAO/0000755000175000017500000000000013021324543015722 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/CIAO/HOOK.pl0000644000175000017500000000053613021324543017023 0ustar spaspa% hook file for CIAO Prolog :- use_module(library(prolog_sys), [statistics/2]). % Count is passed as first argument get_count(Count) :- current_prolog_flag(argv, L), L = [ACount|_], atom_codes(ACount, LCodes), number_codes(Count, LCodes). get_cpu_time(T) :- statistics(runtime, [T, _]). % main/0 needed by ciaoc main. :- initialization(q). gprolog-1.4.5/examples/ExamplesPl/CIAO/MAKE_CLEAN0000755000175000017500000000002713021324543017266 0ustar spaspa#!/bin/sh rm -f [a-z]* gprolog-1.4.5/examples/ExamplesPl/CIAO/MAKE_PROGS0000755000175000017500000000047013021324543017340 0ustar spaspa#!/bin/sh BENCH_PL=`cat ../PROGS` p=`(cd ..;pwd)` p1=`pwd`; for i in ${*:-$BENCH_PL} do echo $i f=$p1/$i.pl sed -e 's/^:- include(common)\.//' $p/$i.pl >$f sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f cat $p1/HOOK.pl >>$f ciaoc $f rm -f $i.itf $i.po done gprolog-1.4.5/examples/ExamplesPl/queensn.pl0000644000175000017500000000132113021324543017217 0ustar spaspa% naive queens queensn(ShowResult) :- q10(R), ( ShowResult = true -> write(R), nl ; true). q8(R) :- q([1,2,3,4,5,6,7,8], R). q10(R) :- q([1,2,3,4,5,6,7,8,9,10], R). q(L,C):- perm(L,P), pair(L,P,C), safe([],C). perm([],[]). perm(Xs,[Z|Zs]):- sel(Z,Xs,Ys), perm(Ys,Zs). sel(X,[X|Xs],Xs). sel(X,[Y|Ys],[Y|Zs]):- sel(X,Ys,Zs). pair([],[],[]). pair([X|Y],[U|V],[p(X,U)|W]):- pair(Y,V,W). safe(_X,[]). safe(X,[Q|R]):- test(X,Q), safe([Q|X],R). test([],_X). test([R|S],Q):- test(S,Q), nd(R,Q). nd(p(C1,R1),p(C2,R2)):- C is C1-C2, R is R1-R2, C=\=R, NR is R2-R1, C=\=NR. % benchmark interface benchmark(ShowResult) :- queensn(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/Makefile0000644000175000017500000000353013021324543016650 0ustar spaspaGPLC = gplc GPLCFLAGS= --fast-math --min-bips BENCH_PL = boyer browse cal chat_parser crypt ham meta_qsort nand nrev \ poly_10 qsort queens queensn query reducer sdda sendmore \ tak tak_gvar zebra .SUFFIXES: .SUFFIXES: .pl $(SUFFIXES) all: $(BENCH_PL) clean: rm -f $(BENCH_PL) *.exe boyer: boyer.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o boyer boyer.pl browse: browse.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o browse browse.pl cal: cal.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o cal cal.pl chat_parser: chat_parser.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o chat_parser chat_parser.pl crypt: crypt.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o crypt crypt.pl ham: ham.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o ham ham.pl meta_qsort: meta_qsort.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o meta_qsort meta_qsort.pl nand: nand.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o nand nand.pl nrev: nrev.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o nrev nrev.pl poly_10: poly_10.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o poly_10 poly_10.pl qsort: qsort.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o qsort qsort.pl queens: queens.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o queens queens.pl queensn: queensn.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o queensn queensn.pl query: query.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o query query.pl reducer: reducer.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o reducer reducer.pl sdda: sdda.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o sdda sdda.pl sendmore: sendmore.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o sendmore sendmore.pl tak: tak.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o tak tak.pl tak_gvar: tak_gvar.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o tak_gvar tak_gvar.pl zebra: zebra.pl common.pl hook.pl $(GPLC) $(GPLCFLAGS) -o zebra zebra.pl gprolog-1.4.5/examples/ExamplesPl/chat_parser.pl0000644000175000017500000006011213021324543020037 0ustar spaspa% generated: 19 November 1989 % option(s): % % chat_parser % % Fernando C. N. Pereira and David H. D. Warren chat_parser(_) :- chat_parser1. chat_parser1 :- string(X), determinate_say(X,_), fail. chat_parser1. % query set string([what,rivers,are,there,?]). string([does,afghanistan,border,china,?]). string([what,is,the,capital,of,upper_volta,?]). string([where,is,the,largest,country,?]). string([which,country,'`',s,capital,is,london,?]). string([which,countries,are,european,?]). string([how,large,is,the,smallest,american,country,?]). string([what,is,the,ocean,that,borders,african,countries, and,that,borders,asian,countries,?]). string([what,are,the,capitals,of,the,countries,bordering,the,baltic,?]). string([which,countries,are,bordered,by,two,seas,?]). string([how,many,countries,does,the,danube,flow,through,?]). string([what,is,the,total,area,of,countries,south,of,the,equator, and,not,in,australasia,?]). string([what,is,the,average,area,of,the,countries,in,each,continent,?]). string([is,there,more,than,one,country,in,each,continent,?]). string([is,there,some,ocean,that,does,not,border,any,country,?]). string([what,are,the,countries,from,which,a,river,flows, into,the,black_sea,?]). % determinate_say determinate_say(X,Y) :- say(X,Y), !. %----------------------------------------------------------------------------- % % xgrun % %----------------------------------------------------------------------------- terminal(T,S,S,x(_,terminal,T,X),X). terminal(T,[T|S],S,X,X) :- gap(X). gap(x(gap,_,_,_)). gap([]). virtual(NT,x(_,nonterminal,NT,X),X). %---------------------------------------------------------------------------- % % clotab % %---------------------------------------------------------------------------- % normal form masks is_pp(#(1,_,_,_)). is_pred(#(_,1,_,_)). is_tracee(#(_,_,1,_)). is_adv(#(_,_,_,1)). tracee(#(_,_,1,_),#(0,0,0,0)). tracee(#(0,0,1,0)). adv(#(0,0,0,1)). empty(#(0,0,0,0)). np_all(#(1,1,1,0)). s_all(#(1,0,1,1)). np_no_tracee(#(1,1,0,0)). % mask operations myplus(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :- or(B1,C1,D1), or(B2,C2,D2), or(B3,C3,D3), or(B4,C4,D4). minus(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :- anot(B1,C1,D1), anot(B2,C2,D2), anot(B3,C3,D3), anot(B4,C4,D4). or(1,_,1). or(0,1,1). or(0,0,0). anot(X,0,X). anot(_X,1,0). % noun phrase position features role(subj,_,#(1,0,0)). role(compl,_,#(0,_,_)). role(undef,main,#(_,0,_)). role(undef,aux,#(0,_,_)). role(undef,decl,_). role(nil,_,_). subj_case(#(1,0,0)). verb_case(#(0,1,0)). prep_case(#(0,0,1)). compl_case(#(0,_,_)). %---------------------------------------------------------------------------- % % newg % %---------------------------------------------------------------------------- say(X,Y) :- sentence(Y,X,[],[],[]). sentence(B,C,D,E,F) :- declarative(B,C,G,E,H), terminator(.,G,D,H,F). sentence(B,C,D,E,F) :- wh_question(B,C,G,E,H), terminator(?,G,D,H,F). sentence(B,C,D,E,F) :- topic(C,G,E,H), wh_question(B,G,I,H,J), terminator(?,I,D,J,F). sentence(B,C,D,E,F) :- yn_question(B,C,G,E,H), terminator(?,G,D,H,F). sentence(B,C,D,E,F) :- imperative(B,C,G,E,H), terminator(!,G,D,H,F). pp(B,C,D,E,F,F,G,H) :- virtual(pp(B,C,D,E),G,H). pp(pp(B,C),D,E,F,G,H,I,J) :- prep(B,G,K,I,L), prep_case(M), np(C,_N,M,_O,D,E,F,K,H,L,J). topic(B,C,D,x(gap,nonterminal,pp(E,compl,F,G),H)) :- pp(E,compl,F,G,B,I,D,J), opt_comma(I,C,J,H). opt_comma(B,C,D,E) :- '`'(',',B,C,D,E). opt_comma(B,B,C,C). declarative(decl(B),C,D,E,F) :- s(B,_G,C,D,E,F). wh_question(whq(B,C),D,E,F,G) :- variable_q(B,_H,I,J,D,K,F,L), question(I,J,C,K,E,L,G). np(B,C,D,E,F,G,H,I,I,J,K) :- virtual(np(B,C,D,E,F,G,H),J,K). np(np(B,C,[]),B,D,def,_E,F,G,H,I,J,K) :- is_pp(F), pers_pron(C,B,L,H,I,J,K), empty(G), role(L,decl,D). np(np(B,C,D),B,_E,F,G,H,I,J,K,L,M) :- is_pp(H), np_head(C,B,F+N,O,D,J,P,L,Q), np_all(R), np_compls(N,B,G,O,R,I,P,K,Q,M). np(part(B,C),3+D,_E,indef,F,G,H,I,J,K,L) :- is_pp(G), determiner(B,D,indef,I,M,K,N), '`'(of,M,O,N,P), s_all(Q), prep_case(R), np(C,3+plu,R,def,F,Q,H,O,J,P,L). variable_q(B,C,D,E,F,G,H,x(gap,nonterminal,np(I,C,E,_J,_K,L,M),N)) :- whq(B,C,I,D,F,G,H,N), tracee(L,M). variable_q(B,C,compl,D,E,F,G,x(gap,nonterminal,pp(pp(H,I),compl,J,K),L)) :- prep(H,E,M,G,N), whq(B,C,I,_O,M,F,N,L), tracee(J,K), compl_case(D). variable_q(B,C,compl,D,E,F,G,x(gap,nonterminal, adv_phrase(pp(H,np(C,np_head(int_det(B),[],I),[])),J,K),L)) :- context_pron(H,I,E,F,G,L), tracee(J,K), verb_case(D). variable_q(B,_C,compl,D,E,F,G, x(gap,nonterminal,predicate(adj,value(H,wh(B)),I),J)) :- '`'(how,E,K,G,L), adj(quant,H,K,F,L,J), empty(I), verb_case(D). adv_phrase(B,C,D,E,E,F,G) :- virtual(adv_phrase(B,C,D),F,G). adv_phrase(pp(B,C),D,E,F,G,H,I) :- loc_pred(B,F,J,H,K), pp(pp(prep(of),C),compl,D,E,J,G,K,I). predicate(B,C,D,E,E,F,G) :- virtual(predicate(B,C,D),F,G). predicate(_B,C,D,E,F,G,H) :- adj_phrase(C,D,E,F,G,H). predicate(neg,B,C,D,E,F,G) :- s_all(H), pp(B,compl,H,C,D,E,F,G). predicate(_B,C,D,E,F,G,H) :- s_all(I), adv_phrase(C,I,D,E,F,G,H). whq(B,C,D,undef,E,F,G,H) :- int_det(B,C,E,I,G,J), s_all(K), np(D,C,_L,_M,subj,K,_N,I,F,J,H). whq(B,3+C,np(3+C,wh(B),[]),D,E,F,G,H) :- int_pron(D,E,F,G,H). int_det(B,3+C,D,E,F,G) :- whose(B,C,D,E,F,G). int_det(B,3+C,D,E,F,G) :- int_art(B,C,D,E,F,G). gen_marker(B,B,C,D) :- virtual(gen_marker,C,D). gen_marker(B,C,D,E) :- '`'('`',B,F,D,G), an_s(F,C,G,E). whose(B,C,D,E,F,x(nogap,nonterminal,np_head0(wh(B),C,proper), x(nogap,nonterminal,gen_marker,G))) :- '`'(whose,D,E,F,G). question(B,C,D,E,F,G,H) :- subj_question(B), role(subj,_I,C), s(D,_J,E,F,G,H). question(B,C,D,E,F,G,H) :- fronted_verb(B,C,E,I,G,J), s(D,_K,I,F,J,H). det(B,C,D,E,E,F,G) :- virtual(det(B,C,D),F,G). det(det(B),C,D,E,F,G,H) :- terminal(I,E,F,G,H), det(I,C,B,D). det(generic,_B,generic,C,C,D,D). int_art(B,C,D,E,F,x(nogap,nonterminal,det(G,C,def),H)) :- int_art(B,C,G,D,E,F,H). subj_question(subj). subj_question(undef). yn_question(q(B),C,D,E,F) :- fronted_verb(nil,_G,C,H,E,I), s(B,_J,H,D,I,F). verb_form(B,C,D,E,F,F,G,H) :- virtual(verb_form(B,C,D,E),G,H). verb_form(B,C,D,_E,F,G,H,I) :- terminal(J,F,G,H,I), verb_form(J,B,C,D). neg(B,C,D,D,E,F) :- virtual(neg(B,C),E,F). neg(aux+_B,neg,C,D,E,F) :- '`'(not,C,D,E,F). neg(_B,pos,C,C,D,D). fronted_verb(B,C,D,E,F,x(gap,nonterminal,verb_form(G,H,I,J), x(nogap,nonterminal,neg(_K,L),M))) :- verb_form(G,H,I,_N,D,O,F,P), verb_type(G,aux+_Q), role(B,J,C), neg(_R,L,O,E,P,M). imperative(imp(B),C,D,E,F) :- imperative_verb(C,G,E,H), s(B,_I,G,D,H,F). imperative_verb(B,C,D,x(nogap,terminal,you,x(nogap,nonterminal, verb_form(E,imp+fin,2+sin,main),F))) :- verb_form(E,inf,_G,_H,B,C,D,F). s(s(B,C,D,E),F,G,H,I,J) :- subj(B,K,L,G,M,I,N), verb(C,K,L,O,M,P,N,Q), empty(R), s_all(S), verb_args(L,O,D,R,T,P,U,Q,V), minus(S,T,W), myplus(S,T,X), verb_mods(E,W,X,F,U,H,V,J). subj(there,_B,_C+be,D,E,F,G) :- '`'(there,D,E,F,G). subj(B,C,_D,E,F,G,H) :- s_all(I), subj_case(J), np(B,C,J,_K,subj,I,_L,E,F,G,H). np_head(B,C,D,E,F,G,H,I,J) :- np_head0(K,L,M,G,N,I,O), possessive(K,L,M,P,P,B,C,D,E,F,N,H,O,J). np_head0(B,C,D,E,E,F,G) :- virtual(np_head0(B,C,D),F,G). np_head0(name(B),3+sin,def+proper,C,D,E,F) :- name(B,C,D,E,F). np_head0(np_head(B,C,D),3+E,F+common,G,H,I,J) :- determiner(B,E,F,G,K,I,L), adjs(C,K,M,L,N), noun(D,E,M,H,N,J). np_head0(B,C,def+proper,D,E,F,x(nogap,nonterminal,gen_marker,G)) :- poss_pron(B,C,D,E,F,G). np_head0(np_head(B,[],C),3+sin,indef+common,D,E,F,G) :- quantifier_pron(B,C,D,E,F,G). np_compls(proper,_B,_C,[],_D,E,F,F,G,G) :- empty(E). np_compls(common,B,C,D,E,F,G,H,I,J) :- np_all(K), np_mods(B,C,L,D,E,M,K,N,G,O,I,P), relative(B,L,M,N,F,O,H,P,J). possessive(B,C,_D,[],E,F,G,H,I,J,K,L,M,N) :- gen_case(K,O,M,P), np_head0(Q,R,S,O,T,P,U), possessive(Q,R,S,V,[pp(poss,np(C,B,E))|V],F,G,H,I,J,T,L,U,N). possessive(B,C,D,E,F,B,C,D,E,F,G,G,H,H). gen_case(B,C,D,x(nogap,terminal,the,E)) :- gen_marker(B,C,D,E). an_s(B,C,D,E) :- '`'(s,B,C,D,E). an_s(B,B,C,C). determiner(B,C,D,E,F,G,H) :- det(B,C,D,E,F,G,H). determiner(B,C,D,E,F,G,H) :- quant_phrase(B,C,D,E,F,G,H). quant_phrase(quant(B,C),D,E,F,G,H,I) :- quant(B,E,F,J,H,K), number(C,D,J,G,K,I). quant(B,indef,C,D,E,F) :- neg_adv(G,B,C,H,E,I), comp_adv(G,H,J,I,K), '`'(than,J,D,K,F). quant(B,indef,C,D,E,F) :- '`'(at,C,G,E,H), sup_adv(I,G,D,H,F), sup_op(I,B). quant(the,def,B,C,D,E) :- '`'(the,B,C,D,E). quant(same,indef,B,B,C,C). neg_adv(B,not+B,C,D,E,F) :- '`'(not,C,D,E,F). neg_adv(B,B,C,C,D,D). sup_op(least,not+less). sup_op(most,not+more). np_mods(B,C,D,[E|F],G,H,_I,J,K,L,M,N) :- np_mod(B,C,E,G,O,K,P,M,Q), tracee(R), myplus(R,O,S), minus(G,S,T), myplus(O,G,U), np_mods(B,C,D,F,T,H,U,J,P,L,Q,N). np_mods(_B,_C,D,D,E,E,F,F,G,G,H,H). np_mod(_B,C,D,E,F,G,H,I,J) :- pp(D,C,E,F,G,H,I,J). np_mod(B,_C,D,E,F,G,H,I,J) :- reduced_relative(B,D,E,F,G,H,I,J). verb_mods([B|C],D,_E,F,G,H,I,J) :- verb_mod(B,D,K,G,L,I,M), tracee(N), myplus(N,K,O), minus(D,O,P), myplus(K,D,Q), verb_mods(C,P,Q,F,L,H,M,J). verb_mods([],_B,C,C,D,D,E,E). verb_mod(B,C,D,E,F,G,H) :- adv_phrase(B,C,D,E,F,G,H). verb_mod(B,C,D,E,F,G,H) :- is_adv(C), adverb(B,E,F,G,H), empty(D). verb_mod(B,C,D,E,F,G,H) :- pp(B,compl,C,D,E,F,G,H). adjs([B|C],D,E,F,G) :- pre_adj(B,D,H,F,I), adjs(C,H,E,I,G). adjs([],B,B,C,C). pre_adj(B,C,D,E,F) :- adj(_G,B,C,D,E,F). pre_adj(B,C,D,E,F) :- sup_phrase(B,C,D,E,F). sup_phrase(sup(most,B),C,D,E,F) :- sup_adj(B,C,D,E,F). sup_phrase(sup(B,C),D,E,F,G) :- sup_adv(B,D,I,F,J), adj(quant,C,I,E,J,G). comp_phrase(comp(B,C,D),E,F,G,H,I) :- comp(B,C,F,J,H,K), np_no_tracee(L), prep_case(M), np(D,_N,M,_O,compl,L,E,J,G,K,I). comp(B,C,D,E,F,G) :- comp_adv(B,D,H,F,I), adj(quant,C,H,J,I,K), '`'(than,J,E,K,G). comp(more,B,C,D,E,F) :- rel_adj(B,C,G,E,H), '`'(than,G,D,H,F). comp(same,B,C,D,E,F) :- '`'(as,C,G,E,H), adj(quant,B,G,I,H,J), '`'(as,I,D,J,F). relative(B,[C],D,_E,F,G,H,I,J) :- is_pred(D), rel_conj(B,_K,C,F,G,H,I,J). relative(_B,[],_C,D,D,E,E,F,F). rel_conj(B,C,D,E,F,G,H,I) :- rel(B,J,K,F,L,H,M), rel_rest(B,C,J,D,K,E,L,G,M,I). rel_rest(B,C,D,E,_F,G,H,I,J,K) :- conj(C,L,D,M,E,H,N,J,O), rel_conj(B,L,M,G,N,I,O,K). rel_rest(_B,_C,D,D,E,E,F,F,G,G). rel(B,rel(C,D),E,F,G,H,I) :- openn(F,J,H,K), variable(B,C,J,L,K,M), s(D,N,L,O,M,P), tracee(Q), minus(N,Q,E), close(O,G,P,I). variable(B,C,D,E,F,x(gap,nonterminal,np(np(B,wh(C),[]),B,_G,_H,_I,J,K),L)) :- '`'(that,D,E,F,L), tracee(J,K). variable(B,C,D,E,F,x(gap,nonterminal,np(G,H,I,_J,_K,L,M),N)) :- wh(C,B,G,H,I,D,E,F,N), tracee(L,M). variable(B,C,D,E,F,x(gap,nonterminal,pp(pp(G,H),compl,I,J),K)) :- prep(G,D,L,F,M), wh(C,B,H,_N,O,L,E,M,K), tracee(I,J), compl_case(O). wh(B,C,np(C,wh(B),[]),C,D,E,F,G,H) :- rel_pron(I,E,F,G,H), role(I,decl,D). wh(B,C,np(D,E,[pp(F,G)]),D,_H,I,J,K,L) :- np_head0(E,D,_M+common,I,N,K,O), prep(F,N,P,O,Q), wh(B,C,G,_R,_S,P,J,Q,L). wh(B,C,D,E,F,G,H,I,J) :- whose(B,C,G,K,I,L), s_all(M), np(D,E,F,def,subj,M,_N,K,H,L,J). reduced_relative(B,C,D,E,F,G,H,I) :- is_pred(D), reduced_rel_conj(B,_J,C,E,F,G,H,I). reduced_rel_conj(B,C,D,E,F,G,H,I) :- reduced_rel(B,J,K,F,L,H,M), reduced_rel_rest(B,C,J,D,K,E,L,G,M,I). reduced_rel_rest(B,C,D,E,_F,G,H,I,J,K) :- conj(C,L,D,M,E,H,N,J,O), reduced_rel_conj(B,L,M,G,N,I,O,K). reduced_rel_rest(_B,_C,D,D,E,E,F,F,G,G). reduced_rel(B,reduced_rel(C,D),E,F,G,H,I) :- openn(F,J,H,K), reduced_wh(B,C,J,L,K,M), s(D,N,L,O,M,P), tracee(Q), minus(N,Q,E), close(O,G,P,I). reduced_wh(B,C,D,E,F,x(nogap,nonterminal, np(np(B,wh(C),[]),B,G,_H,_I,J,K),x(nogap,nonterminal, verb_form(be,pres+fin,B,main),x(nogap,nonterminal, neg(_L,M),x(nogap,nonterminal,predicate(M,N,O),P))))) :- neg(_Q,M,D,R,F,S), predicate(M,N,O,R,E,S,P), tracee(J,K), subj_case(G). reduced_wh(B,C,D,E,F,x(nogap,nonterminal, np(np(B,wh(C),[]),B,G,_H,_I,J,K),x(nogap,nonterminal, verb(L,_M,N,O),P))) :- participle(L,N,O,D,E,F,P), tracee(J,K), subj_case(G). reduced_wh(B,C,D,E,F,x(nogap,nonterminal, np(G,H,I,J,_K,L,M),x(gap,nonterminal, np(np(B,wh(C),[]),B,N,_O,_P,Q,R),S))) :- s_all(T), subj_case(I), verb_case(N), np(G,H,_U,J,subj,T,_V,D,E,F,S), tracee(L,M), tracee(Q,R). verb(B,C,D,E,F,F,G,H) :- virtual(verb(B,C,D,E),G,H). verb(verb(B,C,D+fin,E,F),G,H,C,I,J,K,L) :- verb_form(M,D+fin,G,N,I,O,K,P), verb_type(M,Q), neg(Q,F,O,R,P,S), rest_verb(N,M,B,C,E,R,J,S,L), verb_type(B,H). rest_verb(aux,have,B,C,[perf|D],E,F,G,H) :- verb_form(I,past+part,_J,_K,E,L,G,M), have(I,B,C,D,L,F,M,H). rest_verb(aux,be,B,C,D,E,F,G,H) :- verb_form(I,J,_K,_L,E,M,G,N), be(J,I,B,C,D,M,F,N,H). rest_verb(aux,do,B,active,[],C,D,E,F) :- verb_form(B,inf,_G,_H,C,D,E,F). rest_verb(main,B,B,active,[],C,C,D,D). have(be,B,C,D,E,F,G,H) :- verb_form(I,J,_K,_L,E,M,G,N), be(J,I,B,C,D,M,F,N,H). have(B,B,active,[],C,C,D,D). be(past+part,B,B,passive,[],C,C,D,D). be(pres+part,B,C,D,[prog],E,F,G,H) :- passive(B,C,D,E,F,G,H). passive(be,B,passive,C,D,E,F) :- verb_form(B,past+part,_G,_H,C,D,E,F), verb_type(B,I), passive(I). passive(B,B,active,C,C,D,D). participle(verb(B,C,inf,D,E),F,C,G,H,I,J) :- neg(_K,E,G,L,I,M), verb_form(B,N,_O,_P,L,H,M,J), participle(N,C,D), verb_type(B,F). passive(_B+trans). passive(_B+ditrans). participle(pres+part,active,[prog]). participle(past+part,passive,[]). close(B,B,C,D) :- virtual(close,C,D). openn(B,B,C,x(gap,nonterminal,close,C)). verb_args(_B+C,D,E,F,G,H,I,J,K) :- advs(E,L,_M,H,N,J,O), verb_args(C,D,L,F,G,N,I,O,K). verb_args(trans,active,[arg(dir,B)],_C,D,E,F,G,H) :- verb_arg(np,B,D,E,F,G,H). verb_args(ditrans,_B,[arg(C,D)|E],_F,G,H,I,J,K) :- verb_arg(np,D,L,H,M,J,N), object(C,E,L,G,M,I,N,K). verb_args(be,_B,[void],C,C,D,E,F,G) :- terminal(there,D,E,F,G). verb_args(be,_B,[arg(predicate,C)],_D,E,F,G,H,I) :- pred_conj(_J,C,E,F,G,H,I). verb_args(be,_B,[arg(dir,C)],_D,E,F,G,H,I) :- verb_arg(np,C,E,F,G,H,I). verb_args(have,active,[arg(dir,B)],_C,D,E,F,G,H) :- verb_arg(np,B,D,E,F,G,H). verb_args(B,_C,[],D,D,E,E,F,F) :- no_args(B). object(B,C,D,E,F,G,H,I) :- adv(J), minus(J,D,K), advs(C,L,K,F,M,H,N), obj(B,L,D,E,M,G,N,I). obj(ind,[arg(dir,B)],_C,D,E,F,G,H) :- verb_arg(np,B,D,E,F,G,H). obj(dir,[],B,B,C,C,D,D). pred_conj(B,C,D,E,F,G,H) :- predicate(_I,J,K,E,L,G,M), pred_rest(B,J,C,K,D,L,F,M,H). pred_rest(B,C,D,_E,F,G,H,I,J) :- conj(B,K,C,L,D,G,M,I,N), pred_conj(K,L,F,M,H,N,J). pred_rest(_B,C,C,D,D,E,E,F,F). verb_arg(np,B,C,D,E,F,G) :- s_all(H), verb_case(I), np(B,_J,I,_K,compl,H,C,D,E,F,G). advs([B|C],D,E,F,G,H,I) :- is_adv(E), adverb(B,F,J,H,K), advs(C,D,E,J,G,K,I). advs(B,B,_C,D,D,E,E). adj_phrase(B,C,D,E,F,G) :- adj(_H,B,D,E,F,G), empty(C). adj_phrase(B,C,D,E,F,G) :- comp_phrase(B,C,D,E,F,G). no_args(trans). no_args(ditrans). no_args(intrans). conj(conj(B,C),conj(B,D),E,F,conj(B,E,F),G,H,I,J) :- conj(B,C,D,G,H,I,J). noun(B,C,D,E,F,G) :- terminal(H,D,E,F,G), noun_form(H,B,C). adj(B,adj(C),D,E,F,G) :- terminal(C,D,E,F,G), adj(C,B). prep(prep(B),C,D,E,F) :- terminal(B,C,D,E,F), prep(B). rel_adj(adj(B),C,D,E,F) :- terminal(G,C,D,E,F), rel_adj(G,B). sup_adj(adj(B),C,D,E,F) :- terminal(G,C,D,E,F), sup_adj(G,B). comp_adv(less,B,C,D,E) :- '`'(less,B,C,D,E). comp_adv(more,B,C,D,E) :- '`'(more,B,C,D,E). sup_adv(least,B,C,D,E) :- '`'(least,B,C,D,E). sup_adv(most,B,C,D,E) :- '`'(most,B,C,D,E). rel_pron(B,C,D,E,F) :- terminal(G,C,D,E,F), rel_pron(G,B). name(B,C,D,E,F) :- opt_the(C,G,E,H), terminal(B,G,D,H,F), name(B). int_art(B,plu,quant(same,wh(B)),C,D,E,F) :- '`'(how,C,G,E,H), '`'(many,G,D,H,F). int_art(B,C,D,E,F,G,H) :- terminal(I,E,F,G,H), int_art(I,B,C,D). int_pron(B,C,D,E,F) :- terminal(G,C,D,E,F), int_pron(G,B). adverb(adv(B),C,D,E,F) :- terminal(B,C,D,E,F), adverb(B). poss_pron(pronoun(B),C+D,E,F,G,H) :- terminal(I,E,F,G,H), poss_pron(I,B,C,D). pers_pron(pronoun(B),C+D,E,F,G,H,I) :- terminal(J,F,G,H,I), pers_pron(J,B,C,D,E). quantifier_pron(B,C,D,E,F,G) :- terminal(H,D,E,F,G), quantifier_pron(H,B,C). context_pron(prep(in),place,B,C,D,E) :- '`'(where,B,C,D,E). context_pron(prep(at),time,B,C,D,E) :- '`'(when,B,C,D,E). number(nb(B),C,D,E,F,G) :- terminal(H,D,E,F,G), number(H,B,C). terminator(B,C,D,E,F) :- terminal(G,C,D,E,F), terminator(G,B). opt_the(B,B,C,C). opt_the(B,C,D,E) :- '`'(the,B,C,D,E). conj(_B,list,list,C,D,E,F) :- terminal(',',C,D,E,F). conj(B,list,'end',C,D,E,F) :- terminal(B,C,D,E,F), conj(B). loc_pred(B,C,D,E,F) :- terminal(G,C,D,E,F), loc_pred(G,B). '`'(B,C,D,E,F) :- terminal(B,C,D,E,F), '`'(B). %---------------------------------------------------------------------------- % % newdic % %---------------------------------------------------------------------------- word(Word) :- '`'(Word). word(Word) :- conj(Word). word(Word) :- adverb(Word). word(Word) :- sup_adj(Word,_). word(Word) :- rel_adj(Word,_). word(Word) :- adj(Word,_). word(Word) :- name(Word). word(Word) :- terminator(Word,_). word(Word) :- pers_pron(Word,_,_,_,_). word(Word) :- poss_pron(Word,_,_,_). word(Word) :- rel_pron(Word,_). word(Word) :- verb_form(Word,_,_,_). word(Word) :- noun_form(Word,_,_). word(Word) :- prep(Word). word(Word) :- quantifier_pron(Word,_,_). word(Word) :- number(Word,_,_). word(Word) :- det(Word,_,_,_). word(Word) :- int_art(Word,_,_,_). word(Word) :- int_pron(Word,_). word(Word) :- loc_pred(Word,_). '`'(how). '`'(whose). '`'(there). '`'(of). '`'('`'). % use ` instead of ' to help assembler '`'(','). '`'(s). '`'(than). '`'(at). '`'(the). '`'(not). '`'(as). '`'(that). '`'(less). '`'(more). '`'(least). '`'(most). '`'(many). '`'(where). '`'(when). conj(and). conj(or). int_pron(what,undef). int_pron(which,undef). int_pron(who,subj). int_pron(whom,compl). int_art(what,X,_,int_det(X)). int_art(which,X,_,int_det(X)). det(the,No,the(No),def). det(a,sin,a,indef). det(an,sin,a,indef). det(every,sin,every,indef). det(some,_,some,indef). det(any,_,any,indef). det(all,plu,all,indef). det(each,sin,each,indef). det(no,_,no,indef). number(W,I,Nb) :- tr_number(W,I), ag_number(I,Nb). tr_number(nb(I),I). tr_number(one,1). tr_number(two,2). tr_number(three,3). tr_number(four,4). tr_number(five,5). tr_number(six,6). tr_number(seven,7). tr_number(eight,8). tr_number(nine,9). tr_number(ten,10). ag_number(1,sin). ag_number(N,plu) :- N>1. quantifier_pron(everybody,every,person). quantifier_pron(everyone,every,person). quantifier_pron(everything,every,thing). quantifier_pron(somebody,some,person). quantifier_pron(someone,some,person). quantifier_pron(something,some,thing). quantifier_pron(anybody,any,person). quantifier_pron(anyone,any,person). quantifier_pron(anything,any,thing). quantifier_pron(nobody,no,person). quantifier_pron(nothing,no,thing). prep(as). prep(at). prep(of). prep(to). prep(by). prep(with). prep(in). prep(on). prep(from). prep(into). prep(through). noun_form(Plu,Sin,plu) :- noun_plu(Plu,Sin). noun_form(Sin,Sin,sin) :- noun_sin(Sin). noun_form(proportion,proportion,_). noun_form(percentage,percentage,_). root_form(1+sin). root_form(2+_). root_form(1+plu). root_form(3+plu). verb_root(be). verb_root(have). verb_root(do). verb_root(border). verb_root(contain). verb_root(drain). verb_root(exceed). verb_root(flow). verb_root(rise). regular_pres(have). regular_pres(do). regular_pres(rise). regular_pres(border). regular_pres(contain). regular_pres(drain). regular_pres(exceed). regular_pres(flow). regular_past(had,have). regular_past(bordered,border). regular_past(contained,contain). regular_past(drained,drain). regular_past(exceeded,exceed). regular_past(flowed,flow). rel_pron(who,subj). rel_pron(whom,compl). rel_pron(which,undef). poss_pron(my,_,1,sin). poss_pron(your,_,2,_). poss_pron(his,masc,3,sin). poss_pron(her,fem,3,sin). poss_pron(its,neut,3,sin). poss_pron(our,_,1,plu). poss_pron(their,_,3,plu). pers_pron(i,_,1,sin,subj). pers_pron(you,_,2,_,_). pers_pron(he,masc,3,sin,subj). pers_pron(she,fem,3,sin,subj). pers_pron(it,neut,3,sin,_). pers_pron(we,_,1,plu,subj). pers_pron(them,_,3,plu,subj). pers_pron(me,_,1,sin,compl(_)). pers_pron(him,masc,3,sin,compl(_)). pers_pron(her,fem,3,sin,compl(_)). pers_pron(us,_,1,plu,compl(_)). pers_pron(them,_,3,plu,compl(_)). terminator(.,_). terminator(?,?). terminator(!,!). name(_). % =========================================================================== % specialised dictionary loc_pred(east,prep(eastof)). loc_pred(west,prep(westof)). loc_pred(north,prep(northof)). loc_pred(south,prep(southof)). adj(minimum,restr). adj(maximum,restr). adj(average,restr). adj(total,restr). adj(african,restr). adj(american,restr). adj(asian,restr). adj(european,restr). adj(great,quant). adj(big,quant). adj(small,quant). adj(large,quant). adj(old,quant). adj(new,quant). adj(populous,quant). rel_adj(greater,great). rel_adj(less,small). rel_adj(bigger,big). rel_adj(smaller,small). rel_adj(larger,large). rel_adj(older,old). rel_adj(newer,new). sup_adj(biggest,big). sup_adj(smallest,small). sup_adj(largest,large). sup_adj(oldest,old). sup_adj(newest,new). noun_sin(average). noun_sin(total). noun_sin(sum). noun_sin(degree). noun_sin(sqmile). noun_sin(ksqmile). noun_sin(thousand). noun_sin(million). noun_sin(time). noun_sin(place). noun_sin(area). noun_sin(capital). noun_sin(city). noun_sin(continent). noun_sin(country). noun_sin(latitude). noun_sin(longitude). noun_sin(ocean). noun_sin(person). noun_sin(population). noun_sin(region). noun_sin(river). noun_sin(sea). noun_sin(seamass). noun_sin(number). noun_plu(averages,average). noun_plu(totals,total). noun_plu(sums,sum). noun_plu(degrees,degree). noun_plu(sqmiles,sqmile). noun_plu(ksqmiles,ksqmile). noun_plu(million,million). noun_plu(thousand,thousand). noun_plu(times,time). noun_plu(places,place). noun_plu(areas,area). noun_plu(capitals,capital). noun_plu(cities,city). noun_plu(continents,continent). noun_plu(countries,country). noun_plu(latitudes,latitude). noun_plu(longitudes,longitude). noun_plu(oceans,ocean). noun_plu(persons,person). noun_plu(people,person). noun_plu(populations,population). noun_plu(regions,region). noun_plu(rivers,river). noun_plu(seas,sea). noun_plu(seamasses,seamass). noun_plu(numbers,number). verb_form(V,V,inf,_) :- verb_root(V). verb_form(V,V,pres+fin,Agmt) :- regular_pres(V), root_form(Agmt), verb_root(V). verb_form(Past,Root,past+_,_) :- regular_past(Past,Root). verb_form(am,be,pres+fin,1+sin). verb_form(are,be,pres+fin,2+sin). verb_form(is,be,pres+fin,3+sin). verb_form(are,be,pres+fin,_+plu). verb_form(was,be,past+fin,1+sin). verb_form(were,be,past+fin,2+sin). verb_form(was,be,past+fin,3+sin). verb_form(were,be,past+fin,_+plu). verb_form(been,be,past+part,_). verb_form(being,be,pres+part,_). verb_form(has,have,pres+fin,3+sin). verb_form(having,have,pres+part,_). verb_form(does,do,pres+fin,3+sin). verb_form(did,do,past+fin,_). verb_form(doing,do,pres+part,_). verb_form(done,do,past+part,_). verb_form(flows,flow,pres+fin,3+sin). verb_form(flowing,flow,pres+part,_). verb_form(rises,rise,pres+fin,3+sin). verb_form(rose,rise,past+fin,_). verb_form(risen,rise,past+part,_). verb_form(borders,border,pres+fin,3+sin). verb_form(bordering,border,pres+part,_). verb_form(contains,contain,pres+fin,3+sin). verb_form(containing,contain,pres+part,_). verb_form(drains,drain,pres+fin,3+sin). verb_form(draining,drain,pres+part,_). verb_form(exceeds,exceed,pres+fin,3+sin). verb_form(exceeding,exceed,pres+part,_). verb_type(have,aux+have). verb_type(be,aux+be). verb_type(do,aux+ditrans). verb_type(rise,main+intrans). verb_type(border,main+trans). verb_type(contain,main+trans). verb_type(drain,main+intrans). verb_type(exceed,main+trans). verb_type(flow,main+intrans). adverb(yesterday). adverb(tomorrow). % benchmark interface benchmark(ShowResult) :- chat_parser(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/boyer.pl0000644000175000017500000002517313021324543016674 0ustar spaspa% generated: 20 November 1989 % option(s): % % boyer % % Evan Tick (from Lisp version by R. P. Gabriel) % % November 1985 % % prove arithmetic theorem boyer(ShowResult) :- wff(Wff), ( ShowResult = true -> write('rewriting...'), nl ; true), rewrite(Wff,NewWff), ( ShowResult = true -> write('proving...'), nl ; true), tautology(NewWff,[],[]). wff(implies(and(implies(X,Y), and(implies(Y,Z), and(implies(Z,U), implies(U,W)))), implies(X,W))) :- X = f(plus(plus(a,b),plus(c,zero))), Y = f(times(times(a,b),plus(c,d))), Z = f(reverse(append(append(a,b),[]))), U = equal(plus(a,b),difference(x,y)), W = lessp(remainder(a,b),member(a,length(b))). tautology(Wff,Tlist,Flist) :- (truep(Wff,Tlist) -> true ;falsep(Wff,Flist) -> fail ;Wff = if(If,Then,Else) -> (truep(If,Tlist) -> tautology(Then,Tlist,Flist) ;falsep(If,Flist) -> tautology(Else,Tlist,Flist) ;tautology(Then,[If|Tlist],Flist), % both must hold tautology(Else,Tlist,[If|Flist]) ) ),!. rewrite(Atom,Atom) :- atomic(Atom),!. rewrite(Old,New) :- functor(Old,F,N), functor(Mid,F,N), rewrite_args(N,Old,Mid), ( equal(Mid,Next), % should be ->, but is compiler smart rewrite(Next,New) % enough to generate cut for -> ? ; New=Mid ),!. rewrite_args(0,_,_) :- !. rewrite_args(N,Old,Mid) :- arg(N,Old,OldArg), arg(N,Mid,MidArg), rewrite(OldArg,MidArg), N1 is N-1, rewrite_args(N1,Old,Mid). truep(t,_) :- !. truep(Wff,Tlist) :- mymemberchk(Wff,Tlist). falsep(f,_) :- !. falsep(Wff,Flist) :- mymemberchk(Wff,Flist). mymemberchk(X,[X|_]) :- !. mymemberchk(X,[_|T]) :- mymemberchk(X,T). equal( and(P,Q), if(P,if(Q,t,f),f) ). equal( append(append(X,Y),Z), append(X,append(Y,Z)) ). equal( assignment(X,append(A,B)), if(assignedp(X,A), assignment(X,A), assignment(X,B)) ). equal( assume_false(Var,Alist), cons(cons(Var,f),Alist) ). equal( assume_true(Var,Alist), cons(cons(Var,t),Alist) ). equal( boolean(X), or(equal(X,t),equal(X,f)) ). equal( car(gopher(X)), if(listp(X), car(flatten(X)), zero) ). equal( compile(Form), reverse(codegen(optimize(Form),[])) ). equal( count_list(Z,sort_lp(X,Y)), plus(count_list(Z,X), count_list(Z,Y)) ). equal( countps_(L,Pred), countps_loop(L,Pred,zero) ). equal( difference(A,B), C ) :- difference(A,B,C). equal( divides(X,Y), zerop(remainder(Y,X)) ). equal( dsort(X), sort2(X) ). equal( eqp(X,Y), equal(fix(X),fix(Y)) ). equal( equal(A,B), C ) :- eq(A,B,C). equal( even1(X), if(zerop(X),t,odd(decr(X))) ). equal( exec(append(X,Y),Pds,Envrn), exec(Y,exec(X,Pds,Envrn),Envrn) ). equal( exp(A,B), C ) :- exp(A,B,C). equal( fact_(I), fact_loop(I,1) ). equal( falsify(X), falsify1(normalize(X),[]) ). equal( fix(X), if(numberp(X),X,zero) ). equal( flatten(cdr(gopher(X))), if(listp(X), cdr(flatten(X)), cons(zero,[])) ). equal( gcd(A,B), C ) :- gcd(A,B,C). equal( get(J,set(I,Val,Mem)), if(eqp(J,I),Val,get(J,Mem)) ). equal( greatereqp(X,Y), not(lessp(X,Y)) ). equal( greatereqpr(X,Y), not(lessp(X,Y)) ). equal( greaterp(X,Y), lessp(Y,X) ). equal( if(if(A,B,C),D,E), if(A,if(B,D,E),if(C,D,E)) ). equal( iff(X,Y), and(implies(X,Y),implies(Y,X)) ). equal( implies(P,Q), if(P,if(Q,t,f),t) ). equal( last(append(A,B)), if(listp(B), last(B), if(listp(A), cons(car(last(A))), B)) ). equal( length(A), B ) :- mylength(A,B). equal( lesseqp(X,Y), not(lessp(Y,X)) ). equal( lessp(A,B), C ) :- lessp(A,B,C). equal( listp(gopher(X)), listp(X) ). equal( mc_flatten(X,Y), append(flatten(X),Y) ). equal( meaning(A,B), C ) :- meaning(A,B,C). equal( member(A,B), C ) :- mymember(A,B,C). equal( not(P), if(P,f,t) ). equal( nth(A,B), C ) :- n_th(A,B,C). equal( numberp(greatest_factor(X,Y)), not(and(or(zerop(Y),equal(Y,1)), not(numberp(X)))) ). equal( or(P,Q), if(P,t,if(Q,t,f),f) ). equal( plus(A,B), C ) :- plus(A,B,C). equal( power_eval(A,B), C ) :- power_eval(A,B,C). equal( prime(X), and(not(zerop(X)), and(not(equal(X,add1(zero))), prime1(X,decr(X)))) ). equal( prime_list(append(X,Y)), and(prime_list(X),prime_list(Y)) ). equal( quotient(A,B), C ) :- quotient(A,B,C). equal( remainder(A,B), C ) :- remainder(A,B,C). equal( reverse_(X), reverse_loop(X,[]) ). equal( reverse(append(A,B)), append(reverse(B),reverse(A)) ). equal( reverse_loop(A,B), C ) :- reverse_loop(A,B,C). equal( samefringe(X,Y), equal(flatten(X),flatten(Y)) ). equal( sigma(zero,I), quotient(times(I,add1(I)),2) ). equal( sort2(delete(X,L)), delete(X,sort2(L)) ). equal( tautology_checker(X), tautologyp(normalize(X),[]) ). equal( times(A,B), C ) :- times(A,B,C). equal( times_list(append(X,Y)), times(times_list(X),times_list(Y)) ). equal( value(normalize(X),A), value(X,A) ). equal( zerop(X), or(equal(X,zero),not(numberp(X))) ). difference(X, X, zero) :- !. difference(plus(X,Y), X, fix(Y)) :- !. difference(plus(Y,X), X, fix(Y)) :- !. difference(plus(X,Y), plus(X,Z), difference(Y,Z)) :- !. difference(plus(B,plus(A,C)), A, plus(B,C)) :- !. difference(add1(plus(Y,Z)), Z, add1(Y)) :- !. difference(add1(add1(X)), 2, fix(X)). eq(plus(A,B), zero, and(zerop(A),zerop(B))) :- !. eq(plus(A,B), plus(A,C), equal(fix(B),fix(C))) :- !. eq(zero, difference(X,Y),not(lessp(Y,X))) :- !. eq(X, difference(X,Y),and(numberp(X), and(or(equal(X,zero), zerop(Y))))) :- !. eq(times(X,Y), zero, or(zerop(X),zerop(Y))) :- !. eq(append(A,B), append(A,C), equal(B,C)) :- !. eq(flatten(X), cons(Y,[]), and(nlistp(X),equal(X,Y))) :- !. eq(greatest_factor(X,Y),zero, and(or(zerop(Y),equal(Y,1)), equal(X,zero))) :- !. eq(greatest_factor(X,_),1, equal(X,1)) :- !. eq(Z, times(W,Z), and(numberp(Z), or(equal(Z,zero), equal(W,1)))) :- !. eq(X, times(X,Y), or(equal(X,zero), and(numberp(X),equal(Y,1)))) :- !. eq(times(A,B), 1, and(not(equal(A,zero)), and(not(equal(B,zero)), and(numberp(A), and(numberp(B), and(equal(decr(A),zero), equal(decr(B),zero))))))) :- !. eq(difference(X,Y), difference(Z,Y),if(lessp(X,Y), not(lessp(Y,Z)), if(lessp(Z,Y), not(lessp(Y,X)), equal(fix(X),fix(Z))))) :- !. eq(lessp(X,Y), Z, if(lessp(X,Y), equal(t,Z), equal(f,Z))). exp(I, plus(J,K), times(exp(I,J),exp(I,K))) :- !. exp(I, times(J,K), exp(exp(I,J),K)). gcd(X, Y, gcd(Y,X)) :- !. gcd(times(X,Z), times(Y,Z), times(Z,gcd(X,Y))). mylength(reverse(X),length(X)). mylength(cons(_,cons(_,cons(_,cons(_,cons(_,cons(_,X7)))))), plus(6,length(X7))). lessp(remainder(_,Y), Y, not(zerop(Y))) :- !. lessp(quotient(I,J), I, and(not(zerop(I)), or(zerop(J), not(equal(J,1))))) :- !. lessp(remainder(X,Y), X, and(not(zerop(Y)), and(not(zerop(X)), not(lessp(X,Y))))) :- !. lessp(plus(X,Y), plus(X,Z), lessp(Y,Z)) :- !. lessp(times(X,Z), times(Y,Z), and(not(zerop(Z)), lessp(X,Y))) :- !. lessp(Y, plus(X,Y), not(zerop(X))) :- !. lessp(length(delete(X,L)), length(L), member(X,L)). meaning(plus_tree(append(X,Y)),A, plus(meaning(plus_tree(X),A), meaning(plus_tree(Y),A))) :- !. meaning(plus_tree(plus_fringe(X)),A, fix(meaning(X,A))) :- !. meaning(plus_tree(delete(X,Y)),A, if(member(X,Y), difference(meaning(plus_tree(Y),A), meaning(X,A)), meaning(plus_tree(Y),A))). mymember(X,append(A,B),or(member(X,A),member(X,B))) :- !. mymember(X,reverse(Y),member(X,Y)) :- !. mymember(A,intersect(B,C),and(member(A,B),member(A,C))). n_th(zero,_,zero). n_th([],I,if(zerop(I),[],zero)). n_th(append(A,B),I,append(nth(A,I),nth(B,difference(I,length(A))))). plus(plus(X,Y),Z, plus(X,plus(Y,Z))) :- !. plus(remainder(X,Y), times(Y,quotient(X,Y)), fix(X)) :- !. plus(X,add1(Y), if(numberp(Y), add1(plus(X,Y)), add1(X))). power_eval(big_plus1(L,I,Base),Base, plus(power_eval(L,Base),I)) :- !. power_eval(power_rep(I,Base),Base, fix(I)) :- !. power_eval(big_plus(X,Y,I,Base),Base, plus(I,plus(power_eval(X,Base), power_eval(Y,Base)))) :- !. power_eval(big_plus(power_rep(I,Base), power_rep(J,Base), zero, Base), Base, plus(I,J)). quotient(plus(X,plus(X,Y)),2,plus(X,quotient(Y,2))). quotient(times(Y,X),Y,if(zerop(Y),zero,fix(X))). remainder(_, 1,zero) :- !. remainder(X, X,zero) :- !. remainder(times(_,Z),Z,zero) :- !. remainder(times(Y,_),Y,zero). reverse_loop(X,Y, append(reverse(X),Y)) :- !. reverse_loop(X,[], reverse(X) ). times(X, plus(Y,Z), plus(times(X,Y),times(X,Z)) ) :- !. times(times(X,Y),Z, times(X,times(Y,Z)) ) :- !. times(X, difference(C,W),difference(times(C,X),times(W,X))) :- !. times(X, add1(Y), if(numberp(Y), plus(X,times(X,Y)), fix(X)) ). % benchmark interface benchmark(ShowResult) :- boyer(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/queens.pl0000644000175000017500000000326213021324543017047 0ustar spaspa% generated: 10 November 1989 % option(s): % % (queens) queens_8 % % from Sterling and Shapiro, "The Art of Prolog," page 211. % % This program solves the N queens problem: place N pieces on an N % by N rectangular board so that no two pieces are on the same line % - horizontal, vertical, or diagonal. (N queens so placed on an N % by N chessboard are unable to attack each other in a single move % under the rules of chess.) The strategy is incremental generate- % and-test. % % A solution is specified by a permutation of the list of numbers 1 to % N. The first element of the list is the row number for the queen in % the first column, the second element is the row number for the queen % in the second column, et cetera. This scheme implicitly incorporates % the observation that any solution of the problem has exactly one queen % in each column. % % The program distinguishes symmetric solutions. For example, % % ?- queens(4, Qs). % % produces % % Qs = [3,1,4,2] ; % % Qs = [2,4,1,3] queens(ShowResult) :- queens(16, R), ( ShowResult = true -> write(R), nl ; true). queens(N,Qs):- range(1,N,Ns), queens(Ns,[],Qs). queens([],Qs,Qs). queens(UnplacedQs,SafeQs,Qs):- sel(UnplacedQs,UnplacedQs1,Q), not_attack(SafeQs,Q), queens(UnplacedQs1,[Q|SafeQs],Qs). not_attack(Xs,X):- not_attack(Xs,X,1). not_attack([],_,_). not_attack([Y|Ys],X,N):- X =\= Y+N, X =\= Y-N, N1 is N+1, not_attack(Ys,X,N1). sel([X|Xs],Xs,X). sel([Y|Ys],[Y|Zs],X):- sel(Ys,Zs,X). range(N,N,[N]):- !. range(M,N,[M|Ns]):- M < N, M1 is M+1, range(M1,N,Ns). % benchmark interface benchmark(ShowResult) :- queens(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/qsort.pl0000644000175000017500000000122613021324543016715 0ustar spaspa% qsort % % David H. D. Warren % % quicksort a list of 50 integers qsort(ShowResult) :- qsort([27,74,17,33,94,18,46,83,65,2,32,53,28,85,99,47,28,82,6,11,55,29,39,81,90,37,10,0,66,51,7,21,85,27,31,63,75,4,95,99,11,28,61,74,18,92,40,53,59,8], R, []), ( ShowResult = true -> write(R), nl ; true). qsort([], R, R). qsort([X|L], R, R0) :- partition(L, X, L1, L2), qsort(L2, R1, R0), qsort(L1, R, [X|R1]). partition([],_,[],[]). partition([X|L],Y,[X|L1],L2) :- X =< Y, !, partition(L,Y,L1,L2). partition([X|L],Y,L1,[X|L2]) :- partition(L,Y,L1,L2). % benchmark interface benchmark(ShowResult) :- qsort(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/browse.pl0000644000175000017500000000524713021324543017055 0ustar spaspa% generated: 19 June 1990 % option(s): % % browse % % Tep Dobry (from Lisp version by R. P. Gabriel) % % (modified January 1987 by Herve' Touati) browse(_) :- init(100,10,4, [[a,a,a,b,b,b,b,a,a,a,a,a,b,b,a,a,a], [a,a,b,b,b,b,a,a,[a,a],[b,b]], [a,a,a,b,[b,a],b,a,b,a] ], Symbols), randomize(Symbols,RSymbols,21),!, investigate(RSymbols, [[star(SA),B,star(SB),B,a,star(SA),a,star(SB),star(SA)], [star(SA),star(SB),star(SB),star(SA),[star(SA)],[star(SB)]], [_,_,star(_),[b,a],star(_),_,_] ]). my_length(L, N) :- my_length1(L, 0, N). my_length1([], N, N). my_length1([_|L], M, N) :- M1 is M+1, my_length1(L, M1, N). init(N,M,Npats,Ipats,Result) :- init(N,M,M,Npats,Ipats,Result). init(0,_,_,_,_,_) :- !. init(N,I,M,Npats,Ipats,[Symb|Rest]) :- fill(I,[],L), get_pats(Npats,Ipats,Ppats), J is M - I, fill(J,[pattern(Ppats)|L],Symb), N1 is N - 1, (I =:= 0 -> I1 is M; I1 is I - 1), init(N1,I1,M,Npats,Ipats,Rest). fill(0,L,L) :- !. fill(N,L,[dummy([])|Rest]) :- N1 is N - 1, fill(N1,L,Rest). randomize([],[],_) :- !. randomize(In,[X|Out],Rand) :- my_length(In,Lin), Rand1 is (Rand * 17) mod 251, N is Rand1 mod Lin, split(N,In,X,In1), randomize(In1,Out,Rand1). split(0,[X|Xs],X,Xs) :- !. split(N,[X|Xs],RemovedElt,[X|Ys]) :- N1 is N - 1, split(N1,Xs,RemovedElt,Ys). investigate([],_) :- !. investigate([U|Units],Patterns) :- property(U,pattern,Data), p_investigate(Data,Patterns), investigate(Units,Patterns). get_pats(Npats,Ipats,Result) :- get_pats(Npats,Ipats,Result,Ipats). get_pats(0,_,[],_) :- !. get_pats(N,[X|Xs],[X|Ys],Ipats) :- N1 is N - 1, get_pats(N1,Xs,Ys,Ipats). get_pats(N,[],Ys,Ipats) :- get_pats(N,Ipats,Ys,Ipats). property([],_,_) :- fail. /* do not really need this */ property([Prop|_],P,Val) :- functor(Prop,P,_),!, arg(1,Prop,Val). property([_|RProps],P,Val) :- property(RProps,P,Val). p_investigate([],_). p_investigate([D|Data],Patterns) :- p_match(Patterns,D), p_investigate(Data,Patterns). p_match([],_). p_match([P|Patterns],D) :- (match(D,P),fail; true), p_match(Patterns,D). match([],[]) :- !. match([X|PRest],[Y|SRest]) :- var(Y),!,X = Y, match(PRest,SRest). match(List,[Y|Rest]) :- nonvar(Y),Y = star(X),!, concat(X,SRest,List), match(SRest,Rest). match([X|PRest],[Y|SRest]) :- (atom(X) -> X = Y; match(X,Y)), match(PRest,SRest). concat([],L,L). concat([X|L1],L2,[X|L3]) :- concat(L1,L2,L3). % benchmark interface benchmark(ShowResult) :- browse(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/README0000644000175000017500000000401513021324543016067 0ustar spaspa GNU PROLOG Benchmarks ===================== This directory contains a set of Prolog benchmarks To compile them with GNU Prolog: make Each benchmark accepts a count (nb of iteration) as command-line argument, e.g: zebra 10 house(yellow,norwegian,fox,water,kools) house(blue,ukrainian,horse,tea,chesterfields) house(red,english,snails,milk,winstons) house(ivory,spanish,dog,orange_juice,lucky_strikes) house(green,japanese,zebra,coffee,parliaments) 17 msec per iter, 10 iters, total time : 170 msec NB: only the last iteration displays the solution. Each bench includes the Prolog file common.pl (part recovering the counter from the command-line and ierating the bench). This file includes itself the Prolog source hook.pl defining the predicats get_count/1 (recover the count form the command-line) and get_cpu_time/1 (user time in msec). This makes it possible to run the benchmarks with different systems (defining a hook.pl file for each system). If present, each sub-directorie (YAP, WAMCC, SICSTUS, CIAO, BINPROLOG, XSB, SWI) contains 3 files: MAKE_PROGS: a shell-script building the benchmarks MAKE_CLEAN: a shell-script removing build benchmarks HOOK.pl: the hook file needed for the corresponding system To compile the benchmarks with a given system use MAKE_PROGS in the associated directory (e.g. YAP): cd YAP MAKE_PROGS (or MAKE_PROGS BENCH_NAME...) MAKE_PROGS build the list of benchmarks passed as argument. In none, it builds all benchmarks described in the file ../PROGS. Be sure to be in the sub-directory (cd) before doing MAKE_PROGS. NB: under SICSTUS, the compilation mode is byte-code (compactcode), to activate native code (fastcode) define the environment variable NATIVE. The build benchmark act like under GNU Prolog, accepting a count as command-line argument. It is not mandatory to be in sub-directory for the execution. e.g.: ~/...blabla.../ExamplesPl/YAP/zebra 10 To clean the benchmarks with a given system use MAKE_CLEAN in the associated directory (e.g. YAP): cd YAP MAKE_CLEAN gprolog-1.4.5/examples/ExamplesPl/sdda.pl0000644000175000017500000002652613021324543016472 0ustar spaspa% Sdda3 5-Oct-86 % For use on simulator %% To do: (look for '%%') %% recursion - keep list of call procedures, ignore recursive calls %% problem: doesn't work for typical procedure working on a list, %% since the list is smaller (different) each time. %% possible optimization: "recognize" base case & skip to it %% follow atoms, g is 'any atom', all others unique, does it work? %% stats - write heapused, cputime to files (as comments) %% worst_case - handle ground terms (copy unify, modify atomic) %% handle disjunction - needs worst_case %% add cuts where possible to save space %% fill in rest of built-ins %% how to handle op? %% Handle assert/retract? call? (If given ground terms- ok, vars- no) %% must have ground functor, definite number of args! % Front end for simulator use sdda(ShowResult):- do_sdda(test,_A,_B,_C, ShowResult). % Does the sdda on FileName, instantiates Exitmodes to list of exit modes, % ExitModes structure: [[Funtor/Arity, Activation, Exit], ... ], % e.g. [[a/2, [g,X], [g,g]] do_sdda(_FileName, ExitModes, _BackList, _PredList, ShowResult) :- %%see(FileName), read_procedures(Procs, ExitModes, Entries), % collect all procedures %%seen, ( ShowResult = true -> write('Procedures '), nl, write_list(Procs), nl, write('Entry points '), nl, write_list(Entries), nl, (nonvar(ExitModes) -> % Don't mention there (write('Declared exit modes '), nl, % aren't any write_list(ExitModes), nl) ; true), entry_exit_modes_list(Procs, ExitModes, Entries), write('Exit modes '), nl, write_list(ExitModes), nl ; true). %%% !!! Hard code in read for test: % sdda_entry(c(A,B,C)). % a(X, Y). % a(X, X). % c(A,B,C) :- a(A,B). read_procedures([[a/2,a(_109,_110),a(_148,_148)|_184], [c/3,(c(_191,_192,_193):-a(_191,_192))|_238]|_239], _68,[c(_76,_77,_78)|_102]) :- !. % For each entry point in Entries do sdda, building Known, an unbound-tail list % Known structure: [[Name/Arity, ActivationModes, ExitModes], ...|_], % where ActivationModes and ExitModes are lists of variables and the atom 'g'. % 'g' represents a ground element and variables represent equivalence classes. entry_exit_modes_list(_, _, Entries) :- % Done var(Entries). entry_exit_modes_list(ProcList, Known, [Entry|Entries]) :- Entry =.. [Functor|Act], % Get functor/arity & activation my_length(Act, Arity), % from entry declaration proc_exit_mode(ProcList, Known, [], Functor/Arity, Act, _), % No invoc. entry_exit_modes_list(ProcList, Known, Entries). % Do sdda on procedure Functor/Arity, given activation mode Act. Instantiates % Known to known exit modes and Act to exit modes for Functor/Arity under Act proc_exit_mode(_, _, _, Functor/Arity, Act, Exit) :- built_in(Functor/Arity, Act, Exit). % This is a built-in proc_exit_mode(_, Known, _, Functor/Arity, Act, Exit) :- look_up_act([Functor/Arity, Act, Exit], Known). % Already did this proc_exit_mode(ProcList, Known, Invocations, Functor/Arity, Act, Exit) :- umember([Functor/Arity|Clauses], ProcList), % Look up definition dup(Clauses, ClausesCopy), % Don't munge original clause_exit_modes_list(ProcList, Known, Invocations, ClausesCopy, Act, Exits), (Exits=[] -> fail ; true), % didn't find any => fail worst_case(Exits, Exit), % assume the worst dup(Act, ActCopy), % Need copy because Body add_to_list([Functor/Arity, ActCopy, Exit], Known). % binds Act & Exit proc_exit_mode(_, Known, _, Functor/Arity, Act, Exit) :- write('No such procedure at compile time '), Activation=..[Functor|Act], write(Activation), nl, all_shared(Act, Exit), % return worst possible - all shared add_to_list([Functor/Arity, Act, Exit], Known). my_length(L, N) :- my_length1(L, 0, N). my_length1([], N, N). my_length1([_|L], M, N) :- M1 is M+1, my_length1(L, M1, N). % Analyze all clauses for this procedure, instantiate Exits to all exit modes clause_exit_modes_list(_, _, _, Clauses, _, []) :- var(Clauses), !. % No more clauses => done clause_exit_modes_list(ProcList, Known, Invocations, [Clause|Clauses], Act, Exits) :- eqmember([Clause, Act], Invocations), % This is a recursive write('skipping clause exit mode for '), write(Clause), write(' '), write(Act), nl, clause_exit_modes_list(ProcList, Known, Invocations, % call, ignore Clauses, Act, Exits). % it clause_exit_modes_list(ProcList, Known, Invocations, [Clause|Clauses], Act, [Exit|Exits]) :- dup(Act, Exit), % We'll bind Exit clause_exit_mode(ProcList, Known, [[Clause, Act]|Invocations], Clause, Exit), % Record invocation clause_exit_modes_list(ProcList, Known, Invocations, Clauses, Act, Exits). clause_exit_modes_list(ProcList, Known, Invocations, [_Clause|Clauses], Act, Exits) :- % Unify failed clause_exit_modes_list(ProcList, Known, Invocations, Clauses, Act, Exits). % Given activation modes for this clause, return its exit modes clause_exit_mode(ProcList, Known, Invocations, Clause, Act) :- (Clause = ':-'(Head, Body) ; Clause=Head, Body=true), % Decompose it Head =.. [_|Args], % Bind the head unify(Args, Act), % to activation body_exit_mode(ProcList, Known, Invocations, Body). % do the body body_exit_mode(ProcList, Known, Invocations, ','(Goal, Goals)) :- % Conjunction body_exit_mode(ProcList, Known, Invocations, Goal), % Do 1st body_exit_mode(ProcList, Known, Invocations, Goals). % & rest body_exit_mode(ProcList, Known, Invocation, Goal) :- functor(Goal, Functor, Arity), Goal =.. [Functor|Act], proc_exit_mode(ProcList, Known, Invocation, Functor/Arity, Act, Exit), unify(Act, Exit). % Unifies Left and Right with the special case that the atom 'g' matches % any atom (except []) unify(Left, Left) :- !. % Try standard unify first unify(Left, g) :- % else, is it special case atomic(Left), !, \+ Left=[]. unify(g, Right) :- atomic(Right), !, \+ Right=[]. unify([LeftHead|LeftTail], [RightHead|RightTail]) :- % or list !, unify(LeftHead, RightHead), unify(LeftTail, RightTail). unify(Left, Right) :- % or structure Left =.. [Functor|LeftArgs], Right =.. [Functor|RightArgs], unify(LeftArgs, RightArgs). % Succeed if Left and Right are equivalent, i.e. they are the exact same % with variables renamed equiv(Left, Right) :- equiv(Left, Right, _). equiv(Left, Right, _) :- Left==Right, !. equiv(g, Right, _) :- atomic(Right), !, \+ Right=[]. equiv(Left, g, _) :- atomic(Left), !, \+ Left=[]. equiv(Left, Right, Bindings) :- var(Left), !, var(Right), equiv_vars(Left, Right, Bindings). equiv(Left, Right, Bindings) :- var(Right), !, var(Left), equiv_vars(Left, Right, Bindings). equiv([LeftHead|LeftTail], [RightHead|RightTail], Bindings) :- !, equiv(LeftHead, RightHead, Bindings), equiv(LeftTail, RightTail, Bindings). equiv(Left, Right, Bindings) :- Left=..[Functor|LeftArgs], Right=..[Functor|RightArgs], equiv(LeftArgs, RightArgs, Bindings). equiv_vars(Left, Right, Bindings) :- var(Bindings), !, Bindings=[[Left, Right]|_]. equiv_vars(Left, Right, [[AnyVar, AnyBinding]|_]) :- Left==AnyVar, !, Right==AnyBinding. equiv_vars(Left, Right, [[AnyVar, AnyBinding]|_]) :- Right==AnyBinding, !, Left==AnyVar. equiv_vars(Left, Right, [ _|Bindings]) :- equiv_vars(Left, Right, Bindings). % Make a copy of Orig with new vars. Copy must be a variable. % E.g. dup([A,s(A,B),[B,C]], New) binds New to [X,s(X,Y),[Y,Z]] dup(Orig, Copy) :- dup(Orig, Copy, _). dup(Orig, Copy, Bindings) :- var(Orig), !, dup_var(Orig, Copy, Bindings). dup(Orig, Orig, _) :- % Atoms, including [] atomic(Orig), !. dup([OrigHead|OrigTail], [CopyHead|CopyTail], Bindings) :- !, dup(OrigHead, CopyHead, Bindings), dup(OrigTail, CopyTail, Bindings). dup(Orig, Copy, Bindings) :- Orig=..[Functor|OrigArgs], dup(OrigArgs, CopyArgs, Bindings), Copy=..[Functor|CopyArgs]. dup_var(Orig, Copy, Bindings) :- var(Bindings), !, Bindings=[[Orig, Copy]|_]. dup_var(Orig, Copy, [[AnyVar, Copy]|_]) :- Orig==AnyVar, !. dup_var(Orig, Copy, [_|Bindings]) :- dup_var(Orig, Copy, Bindings). % ----- Built-ins ----- % built_in(true/0, [], []). % No change built_in(fail/0, [], []). % No change built_in((=)/2, [X, Y], [g, g]) :- (atomic(X) ; atomic(Y)). % Ground both if either atomic built_in((=)/2, [X, _Y], [X, X]). % else bind them built_in(/('+',2), [X, Y], [X, Y]). % No change built_in(/('-',2), [X, Y], [X, Y]). % No change built_in(/('*',2), [X, Y], [X, Y]). % No change built_in(/('/',2), [X, Y], [X, Y]). % No change built_in(/('>=',2), [X, Y], [X, Y]). % No change built_in(/('<',2), [X, Y], [X, Y]). % No change built_in((is)/2, [_X, Y], [g, Y]). % Ground result % ----- Utilities ----- % worst_case([], _). %% Doesn't work if any Exits worst_case([Exit|Exits], Worst) :- %% fail to match, e.g. unify(Exit, Worst), %% [[s(1)], [f(1)]]. worst_case(Exits, Worst). look_up_act(_, Known) :- var(Known), !, fail. look_up_act([Functor/Arity, Act, Exit], [[Functor/Arity, KnownAct, Exit]|_]) :- equiv(Act, KnownAct). look_up_act([Functor/Arity, Act, Exit], [_|Known]) :- look_up_act([Functor/Arity, Act, Exit], Known). all_shared(_Act, _Exit) :- %% Wrong fail. % DD: I have put fail since unify/3 does not exist /* all_shared(Act, Exit) :- %% Wrong unify(Act, _, VarModesList), bind_all(_, VarModesList), unify(Act, Exit, VarModesList). bind_all(_, VarModesList) :- var(VarModesList). bind_all(Mode, [[Var, Mode]|VarModesList]) :- var(Mode), bind_all(Mode, VarModesList). bind_all(Mode, [[_, _]|VarModesList]) :- bind_all(Mode, VarModesList). */ % Adds Element to the tail of List, an unbound-tail list add_to_list(Element, List) :- var(List), List=[Element|_]. add_to_list(Element, [_|List]) :- add_to_list(Element, List). % Membership relation for unbound-tail lists umember(_, List) :- var(List), !, fail. umember(Element, [Element|_]). umember(Element, [_|Tail]) :- umember(Element, Tail). /* % Membership relation for standard nil-tail lists member(X, [X|_]). member(X, [_|T]) :- member(X, T). */ % Equiv membership relation for standard nil-tail lists eqmember(X, [Y|_]) :- equiv(X, Y). eqmember(X, [_|T]) :- eqmember(X, T). % Pretty prints unbound-tail lists -- dies on NIL tail lists write_list(List) :- dup(List, NewList), (var(NewList) -> (name_vars(NewList, 0, _), write(NewList)) ; (write('['), write_list2(NewList, 0, _), write('|_].'))), % write('].') to write nil tails nl. write_list2([H|T], NextName, NewNextName) :- name_vars(H, NextName, TempNextName), write(H), (nonvar(T) -> (write(','), nl, write(' '), write_list2(T, TempNextName, NewNextName)) ; NewNextName = TempNextName). name_vars(Term, NextName, NewNextName) :- var(Term), !, make_name(NextName, Term), NewNextName is NextName + 1. name_vars(Term, NextName, NextName) :- atom(Term), !. name_vars([TermHead|TermTail], NextName, NewNextName) :- !, name_vars(TermHead, NextName, TempNextName), name_vars(TermTail, TempNextName, NewNextName). name_vars(Term, NextName, NewNextName) :- Term =.. [_|TermArgs], name_vars(TermArgs, NextName, NewNextName). make_name(IntName, Variable) :- Count is IntName // 26, NewIntName is IntName mod 26 + "A", build_name(Count, NewIntName, Name), name(Variable, Name). build_name(0, IntName, [IntName]) :- !. build_name(Count, IntName, [IntName|Rest]) :- Count>0, NewCount is Count - 1, build_name(NewCount, IntName, Rest). % benchmark interface benchmark(ShowResult) :- sdda(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/common.pl0000644000175000017500000000132213021324543017032 0ustar spaspa% A generic benchmark interface q :- ( get_count(Count) ; Count = 1 ), !, do_bench(Count). do_bench(Count) :- get_cpu_time(T1), iterate_bench(Count), get_cpu_time(T2), Time is T2-T1, TimeIt is Time // Count, write(TimeIt), write(' msec per iter, '), write(Count), write(' iters, total time : '), write(Time), write(' msec'), nl. iterate_bench(Count) :- rep(Count, Last), ShowResult = Last, exec_bench(ShowResult), Last = true. exec_bench(ShowResult) :- benchmark(ShowResult), !. rep(1, true):- !. rep(_, false). rep(N, Last) :- N1 is N - 1, rep(N1, Last). /* * this file should define: * get_count/1 * get_cpu_time/1 * and launch q/0 */ :- include(hook). gprolog-1.4.5/examples/ExamplesPl/nand.pl0000644000175000017500000004776713021324543016511 0ustar spaspa%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % This is a rough approximation to the algorithm presented in: % % "An Algorithm for NAND Decomposition Under Network Constraints," % IEEE Trans. Comp., vol C-18, no. 12, Dec. 1969, p. 1098 % by E. S. Davidson. % % Written by Bruce Holmer % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % I have used the paper's terminology for names used in the program. % % The data structure for representing functions and variables is % function(FunctionNumber, TrueSet, FalseSet, % ConceivableInputs, % ImmediatePredecessors, ImmediateSuccessors, % Predecessors, Successors) % % % Common names used in the program: % % NumVars number of variables (signal inputs) % NumGs current number of variables and functions % Gs list of variable and function data % Gi,Gj,Gk,Gl individual variable or function--letter corresponds to % the subscript in the paper (most of the time) % Vector,V vector from a function's true set % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% nand(ShowResult) :- nand_main(0, ShowResult). nand_main(N, ShowResult) :- init_state(N, NumVars, NumGs, Gs), add_necessary_functions(NumVars, NumGs, Gs, NumGs2, Gs2), test_bounds(NumVars, NumGs2, Gs2), search(NumVars, NumGs2, Gs2, ShowResult). nand_main(_, ShowResult) :- ( ShowResult = true -> write('Search completed'), nl ; true). % Test input % init_state(circuit(NumInputs, NumOutputs, FunctionList)) init_state(0, 2, 3, [ % 2 input xor function(2, [1,2], [0,3], [], [], [], [], []), function(1, [2,3], [0,1], [], [], [], [], []), function(0, [1,3], [0,2], [], [], [], [], []) ]) :- update_bounds(_, 100, _). init_state(1, 3, 4, [ % carry circuit function(3, [3,5,6,7], [0,1,2,4], [], [], [], [], []), function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []), function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []), function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], []) ]) :- update_bounds(_, 100, _). init_state(2, 3, 4, [ % example in paper function(3, [1,2,4,6,7], [0,3,5], [], [], [], [], []), function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []), function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []), function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], []) ]) :- update_bounds(_, 100, _). init_state(3, 3, 4, [ % sum (3 input xor) function(3, [1,2,4,7], [0,3,5,6], [], [], [], [], []), function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []), function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []), function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], []) ]) :- update_bounds(_, 100, _). init_state(4, 3, 5, [ % do sum and carry together function(4, [3,5,6,7], [0,1,2,4], [], [], [], [], []), function(3, [1,2,4,7], [0,3,5,6], [], [], [], [], []), function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []), function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []), function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], []) ]) :- update_bounds(_, 100, _). /* commented for XSB, compiler complexity too high on big lists init_state(5, 5, 8, [ % 2 bit full adder function(7, % A2 (output) [1,3,4,6,9,11,12,14,16,18,21,23,24,26,29,31], [0,2,5,7,8,10,13,15,17,19,20,22,25,27,28,30], [], [], [], [], []), function(6, % B2 (output) [2,3,5,6,8,9,12,15,17,18,20,21,24,27,30,31], [0,1,4,7,10,11,13,14,16,19,22,23,25,26,28,29], [], [], [], [], []), function(5, % carry-out (output) [7,10,11,13,14,15,19,22,23,25,26,27,28,29,30,31], [0,1,2,3,4,5,6,8,9,12,16,17,18,20,21,24], [], [], [], [], []), function(4, % carry-in [16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31], [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15], [], [], [], [], []), function(3, % B1 input [8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31], [0,1,2,3,4,5,6,7,16,17,18,19,20,21,22,23], [], [], [], [], []), function(2, % B0 input [4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31], [0,1,2,3,8,9,10,11,16,17,18,19,24,25,26,27], [], [], [], [], []), function(1, % A1 input [2,3,6,7,10,11,14,15,18,19,22,23,26,27,30,31], [0,1,4,5,8,9,12,13,16,17,20,21,24,25,28,29], [], [], [], [], []), function(0, % A0 input [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31], [0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30], [], [], [], [], []) ]) :- update_bounds(_, 21, _). */ % Iterate over all the TRUE vectors that need to be covered. % If no vectors remain to be covered (select_vector fails), then % the circuit is complete (printout results, update bounds, and % continue search for a lower cost circuit). search(NumVars, NumGsIn, GsIn, ShowResult) :- select_vector(NumVars, NumGsIn, GsIn, Gj, Vector), !, cover_vector(NumVars, NumGsIn, GsIn, Gj, Vector, NumGs, Gs), add_necessary_functions(NumVars, NumGs, Gs, NumGsOut, GsOut), test_bounds(NumVars, NumGsOut, GsOut), search(NumVars, NumGsOut, GsOut, ShowResult). search(NumVars, NumGs, Gs, ShowResult) :- ( ShowResult = true -> output_results(NumVars, NumGs, Gs) ; true), update_bounds(NumVars, NumGs, Gs), fail. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Given the current solution, pick the best uncovered TRUE vector % for covering next. % The selected vector is specified by its vector number and function. % Select_vector fails if all TRUE vectors are covered. % Select_vector is determinant (gives only one solution). select_vector(NumVars, NumGs, Gs, Gj, Vector) :- select_vector(Gs, NumVars, NumGs, Gs, dummy, 0, nf, 999, Gj, Vector, Type, _), !, \+ unif(Type, cov), \+ unif(Type, nf). unif(X, X). % loop over functions select_vector([Gk|_], NumVars, _, _, Gj, V, Type, N, Gj, V, Type, N) :- function_number(Gk, K), K < NumVars. select_vector([Gk|Gks], NumVars, NumGs, Gs, GjIn, Vin, TypeIn, Nin, GjOut, Vout, TypeOut, Nout) :- function_number(Gk, K), K >= NumVars, true_set(Gk, Tk), select_vector(Tk, Gk, NumVars, NumGs, Gs, GjIn, Vin, TypeIn, Nin, Gj, V, Type, N), select_vector(Gks, NumVars, NumGs, Gs, Gj, V, Type, N, GjOut, Vout, TypeOut, Nout). % loop over vectors select_vector([], _, _, _, _, Gj, V, Type, N, Gj, V, Type, N). select_vector([V|Vs], Gk, NumVars, NumGs, Gs, GjIn, Vin, TypeIn, Nin, GjOut, Vout, TypeOut, Nout) :- vector_cover_type(NumVars, Gs, Gk, V, Type, N), best_vector(GjIn, Vin, TypeIn, Nin, Gk, V, Type, N, Gj2, V2, Type2, N2), select_vector(Vs, Gk, NumVars, NumGs, Gs, Gj2, V2, Type2, N2, GjOut, Vout, TypeOut, Nout). vector_cover_type(NumVars, Gs, Gj, Vector, Type, NumCovers) :- immediate_predecessors(Gj, IPs), conceivable_inputs(Gj, CIs), false_set(Gj, Fj), cover_type1(IPs, Gs, Vector, nf, 0, T, N), cover_type2(CIs, Gs, NumVars, Fj, Vector, T, N, Type, NumCovers). cover_type1([], _, _, T, N, T, N). cover_type1([I|IPs], Gs, V, TypeIn, Nin, TypeOut, Nout) :- function(I, Gs, Gi), true_set(Gi, Ti), \+ set_member(V, Ti), !, false_set(Gi, Fi), (set_member(V, Fi) -> max_type(TypeIn, cov, Type); max_type(TypeIn, exp, Type)), N is Nin + 1, cover_type1(IPs, Gs, V, Type, N, TypeOut, Nout). cover_type1([_|IPs], Gs, V, TypeIn, Nin, TypeOut, Nout) :- cover_type1(IPs, Gs, V, TypeIn, Nin, TypeOut, Nout). cover_type2([], _, _, _, _, T, N, T, N). cover_type2([I|CIs], Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout) :- I < NumVars, function(I, Gs, Gi), false_set(Gi, Fi), set_member(V, Fi), !, max_type(TypeIn, var, Type), N is Nin + 1, cover_type2(CIs, Gs, NumVars, Fj, V, Type, N, TypeOut, Nout). cover_type2([I|CIs], Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout) :- I >= NumVars, function(I, Gs, Gi), true_set(Gi, Ti), \+ set_member(V, Ti), !, false_set(Gi, Fi), (set_member(V, Fi) -> (set_subset(Fj, Ti) -> max_type(TypeIn, fcn, Type); max_type(TypeIn, mcf, Type)); (set_subset(Fj, Ti) -> max_type(TypeIn, exf, Type); max_type(TypeIn, exmcf, Type))), N is Nin + 1, cover_type2(CIs, Gs, NumVars, Fj, V, Type, N, TypeOut, Nout). cover_type2([_|CIs], Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout) :- cover_type2(CIs, Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout). % The best vector to cover is the one with worst type, or, if types % are equal, with the least number of possible covers. best_vector(dummy, _, _, _, Gj2, V2, Type2, N2, Gj2, V2, Type2, N2) :- !. best_vector(Gj1, V1, Type1, N1, dummy, _, _, _, Gj1, V1, Type1, N1) :- !. best_vector(Gj1, V1, Type, N1, Gj2, _, Type, N2, Gj1, V1, Type, N1) :- function_number(Gj1, J), function_number(Gj2, J), N1 < N2, !. best_vector(Gj1, _, Type, N1, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :- function_number(Gj1, J), function_number(Gj2, J), N1 >= N2, !. best_vector(Gj1, V1, Type, N1, Gj2, _, Type, _, Gj1, V1, Type, N1) :- (Type = exp ; Type = var), function_number(Gj1, J1), function_number(Gj2, J2), J1 > J2, !. best_vector(Gj1, _, Type, _, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :- (Type = exp ; Type = var), function_number(Gj1, J1), function_number(Gj2, J2), J1 < J2, !. best_vector(Gj1, V1, Type, N1, Gj2, _, Type, _, Gj1, V1, Type, N1) :- \+ unif2(Type, exp, var), function_number(Gj1, J1), function_number(Gj2, J2), J1 < J2, !. best_vector(Gj1, _, Type, _, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :- \+ unif2(Type, exp, var), function_number(Gj1, J1), function_number(Gj2, J2), J1 > J2, !. best_vector(Gj1, V1, Type1, N1, _, _, Type2, _, Gj1, V1, Type1, N1) :- type_order(Type2, Type1), !. best_vector(_, _, Type1, _, Gj2, V2, Type2, N2, Gj2, V2, Type2, N2) :- type_order(Type1, Type2), !. unif2(X, X, _). unif2(X, _, X). max_type(T1, T2, T1) :- type_order(T1, T2), !. max_type(T1, T2, T2) :- \+ type_order(T1, T2), !. % Order of types type_order(cov, exp). type_order(cov, var). type_order(cov, fcn). type_order(cov, mcf). type_order(cov, exf). type_order(cov, exmcf). type_order(cov, nf). type_order(exp, var). type_order(exp, fcn). type_order(exp, mcf). type_order(exp, exf). type_order(exp, exmcf). type_order(exp, nf). type_order(var, fcn). type_order(var, mcf). type_order(var, exf). type_order(var, exmcf). type_order(var, nf). type_order(fcn, mcf). type_order(fcn, exf). type_order(fcn, exmcf). type_order(fcn, nf). type_order(mcf, exf). type_order(mcf, exmcf). type_order(mcf, nf). type_order(exf, exmcf). type_order(exf, nf). type_order(exmcf, nf). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Cover_vector will cover the specified vector and % generate new circuit information. % Using backtracking, all possible coverings are generated. % The ordering of the possible coverings is approximately that % given in Davidson's paper, but has been simplified. cover_vector(NumVars, NumGsIn, GsIn, Gj, Vector, NumGsOut, GsOut) :- immediate_predecessors(Gj, IPs), conceivable_inputs(Gj, CIs), vector_types(Type), cover_vector(Type, IPs, CIs, Gj, Vector, NumVars, NumGsIn, GsIn, NumGsOut, GsOut). vector_types(var). vector_types(exp). vector_types(fcn). vector_types(mcf). vector_types(exf). vector_types(exmcf). vector_types(nf). cover_vector(exp, [I|_], _, Gj, V, _, NumGs, GsIn, NumGs, GsOut) :- function(I, GsIn, Gi), true_set(Gi, Ti), \+ set_member(V, Ti), update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut). cover_vector(exp, [_|IPs], _, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- cover_vector(exp, IPs, _, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut). cover_vector(var, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- I < NumVars, function(I, GsIn, Gi), false_set(Gi, Fi), set_member(V, Fi), update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut). cover_vector(var, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- cover_vector(var, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut). cover_vector(fcn, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- I >= NumVars, function(I, GsIn, Gi), false_set(Gi, Fi), set_member(V, Fi), true_set(Gi, Ti), false_set(Gj, Fj), set_subset(Fj, Ti), update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut). cover_vector(fcn, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- cover_vector(fcn, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut). cover_vector(mcf, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- I >= NumVars, function(I, GsIn, Gi), false_set(Gi, Fi), set_member(V, Fi), true_set(Gi, Ti), false_set(Gj, Fj), \+ set_subset(Fj, Ti), update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut). cover_vector(mcf, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- cover_vector(mcf, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut). cover_vector(exf, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- I >= NumVars, function(I, GsIn, Gi), false_set(Gi, Fi), \+ set_member(V, Fi), true_set(Gi, Ti), \+ set_member(V, Ti), false_set(Gj, Fj), set_subset(Fj, Ti), update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut). cover_vector(exf, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- cover_vector(exf, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut). cover_vector(exmcf, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- I >= NumVars, function(I, GsIn, Gi), false_set(Gi, Fi), \+ set_member(V, Fi), true_set(Gi, Ti), \+ set_member(V, Ti), false_set(Gj, Fj), \+ set_subset(Fj, Ti), update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut). cover_vector(exmcf, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :- cover_vector(exmcf, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut). cover_vector(nf, _, _, Gj, V, NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :- NumGsOut is NumGsIn + 1, false_set(Gj, Fj), new_function_CIs(GsIn, function(NumGsIn,Fj,[V],[],[],[],[],[]), NumVars, Gs, Gi), update_circuit(Gs, Gi, Gj, V, Gs, GsOut). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% update_circuit([], _, _, _, _, []). update_circuit([function(K,Tk,Fk,CIk,IPk,ISk,Pk,Sk)|GsIn], Gi, Gj, V, Gs, [function(K,Tko,Fko,CIko,IPko,ISko,Pko,Sko)|GsOut]) :- Gi = function(I,_,Fi,_,IPi,ISi,Pi,_), Gj = function(J,_,Fj,_,_,_,_,Sj), set_union([I], Pi, PiI), set_union([J], Sj, SjJ), (K = J -> set_union(Tk, Fi, Tk2); Tk2 = Tk), (K = I -> set_union(Tk2, Fj, Tk3); Tk3 = Tk2), ((set_member(K, IPi); set_member(K, ISi)) -> set_union(Tk3, [V], Tko); Tko = Tk3), (K = I -> set_union(Fk, [V], Fko); Fko = Fk), ((set_member(K, Pi); K = I) -> set_difference(CIk, SjJ, CIk2); CIk2 = CIk), ((set_member(I, CIk), set_member(V, Fk)) -> set_difference(CIk2, [I], CIk3); CIk3 = CIk2), (K = I -> exclude_if_vector_in_false_set(CIk3, Gs, V, CIk4); CIk4 = CIk3), (K = J -> set_difference(CIk4, [I], CIko); CIko = CIk4), (K = J -> set_union(IPk, [I], IPko); IPko = IPk), (K = I -> set_union(ISk, [J], ISko); ISko = ISk), (set_member(K, SjJ) -> set_union(Pk, PiI, Pko); Pko = Pk), (set_member(K, PiI) -> set_union(Sk, SjJ, Sko); Sko = Sk), update_circuit(GsIn, Gi, Gj, V, Gs, GsOut). exclude_if_vector_in_false_set([], _, _, []). exclude_if_vector_in_false_set([K|CIsIn], Gs, V, CIsOut) :- function(K, Gs, Gk), false_set(Gk, Fk), set_member(V, Fk), !, exclude_if_vector_in_false_set(CIsIn, Gs, V, CIsOut). exclude_if_vector_in_false_set([K|CIsIn], Gs, V, [K|CIsOut]) :- exclude_if_vector_in_false_set(CIsIn, Gs, V, CIsOut). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add_necessary_functions(NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :- add_necessary_functions(NumVars, NumVars, NumGsIn, GsIn, NumGsOut, GsOut). add_necessary_functions(NumGs, _, NumGs, Gs, NumGs, Gs) :- !. add_necessary_functions(K, NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :- function(K, GsIn, Gk), function_type(NumVars, NumGsIn, GsIn, Gk, nf, V), !, false_set(Gk, Fk), new_function_CIs(GsIn, function(NumGsIn,Fk,[V],[],[],[],[],[]), NumVars, Gs, Gl), function(K, Gs, Gk1), update_circuit(Gs, Gl, Gk1, V, Gs, Gs1), NumGs1 is NumGsIn + 1, K1 is K + 1, add_necessary_functions(K1, NumVars, NumGs1, Gs1, NumGsOut, GsOut). add_necessary_functions(K, NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :- K1 is K + 1, add_necessary_functions(K1, NumVars, NumGsIn, GsIn, NumGsOut, GsOut). new_function_CIs(GsIn, function(L,Tl,Fl,_,IPl,ISl,Pl,Sl), NumVars, [GlOut|GsOut], GlOut) :- new_function_CIs(GsIn, L, Fl, NumVars, GsOut, [], CIlo), GlOut = function(L,Tl,Fl,CIlo,IPl,ISl,Pl,Sl). new_function_CIs([], _, _, _, [], CIl, CIl). new_function_CIs([function(K,Tk,Fk,CIk,IPk,ISk,Pk,Sk)|GsIn], L, Fl, NumVars, [function(K,Tk,Fk,CIko,IPk,ISk,Pk,Sk)|GsOut], CIlIn, CIlOut) :- set_intersection(Fl, Fk, []), !, (K >= NumVars -> set_union(CIk, [L], CIko); CIko = CIk), new_function_CIs(GsIn, L, Fl, NumVars, GsOut, [K|CIlIn], CIlOut). new_function_CIs([Gk|GsIn], L, Fl, NumVars, [Gk|GsOut], CIlIn, CIlOut) :- new_function_CIs(GsIn, L, Fl, NumVars, GsOut, CIlIn, CIlOut). function_type(NumVars, NumGs, Gs, Gk, Type, Vector) :- true_set(Gk, Tk), select_vector(Tk, Gk, NumVars, NumGs, Gs, dummy, 0, nf, 999, _, Vector, Type, _). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Cost and constraint predicates: % very simple bound for now test_bounds(_, NumGs, _) :- access(bound, Bound), NumGs < Bound. update_bounds(_, NumGs, _) :- set(bound, NumGs). % set and access for systems that don't support them /* Original source set(N, A) :- (recorded(N, _, Ref) -> erase(Ref) ; true), recorda(N, A, _). access(N, A) :- recorded(N, A, _). */ /* bet for GNU Prolog set(N, A) :- g_assign(N, A). access(N, A) :- g_read(N, A). */ /* ISO version */ set(N, A) :- ( access(N, _) -> retract(store_value(N, _)) ; true), asserta(store_value(N, A)). access(N, A) :- clause(store_value(N, A), _). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Output predicates: % for now just dump everything output_results(NumVars, NumGs, Gs) :- NumGates is NumGs - NumVars, write(NumGates), write(' gates'), nl, write_gates(Gs), nl, write('searching for a better solution...'), nl, nl. write_gates([]). write_gates([Gi|Gs]) :- function_number(Gi, I), write('gate #'), write(I), write(' inputs: '), immediate_predecessors(Gi, IPi), write(IPi), nl, write_gates(Gs). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Retrieve the specified function from the function list. % function(FunctionNumber, FunctionList, Function). function(I, [Gi|_], Gi) :- function_number(Gi, I), !. function(I, [_|Gs], Gi) :- function(I, Gs, Gi). function_number( function(I,_,_,_,_,_,_,_), I). true_set( function(_,T,_,_,_,_,_,_), T). false_set( function(_,_,F,_,_,_,_,_), F). conceivable_inputs( function(_,_,_,CI,_,_,_,_), CI). immediate_predecessors( function(_,_,_,_,IP,_,_,_), IP). immediate_successors( function(_,_,_,_,_,IS,_,_), IS). predecessors( function(_,_,_,_,_,_,P,_), P). successors( function(_,_,_,_,_,_,_,S), S). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Set operations assume that the sets are represented by an ordered list % of integers. set_union([], [], []). set_union([], [X|L2], [X|L2]). set_union([X|L1], [], [X|L1]). set_union([X|L1], [X|L2], [X|L3]) :- set_union(L1, L2, L3). set_union([X|L1], [Y|L2], [X|L3]) :- X < Y, set_union(L1, [Y|L2], L3). set_union([X|L1], [Y|L2], [Y|L3]) :- X > Y, set_union([X|L1], L2, L3). set_intersection([], [], []). set_intersection([], [_|_], []). set_intersection([_|_], [], []). set_intersection([X|L1], [X|L2], [X|L3]) :- set_intersection(L1, L2, L3). set_intersection([X|L1], [Y|L2], L3) :- X < Y, set_intersection(L1, [Y|L2], L3). set_intersection([X|L1], [Y|L2], L3) :- X > Y, set_intersection([X|L1], L2, L3). set_difference([], [], []). set_difference([], [_|_], []). set_difference([X|L1], [], [X|L1]). set_difference([X|L1], [X|L2], L3) :- set_difference(L1, L2, L3). set_difference([X|L1], [Y|L2], [X|L3]) :- X < Y, set_difference(L1, [Y|L2], L3). set_difference([X|L1], [Y|L2], L3) :- X > Y, set_difference([X|L1], L2, L3). set_subset([], _). set_subset([X|L1], [X|L2]) :- set_subset(L1, L2). set_subset([X|L1], [Y|L2]) :- X > Y, set_subset([X|L1], L2). set_member(X, [X|_]). set_member(X, [Y|T]) :- X > Y, set_member(X, T). % benchmark interface benchmark(ShowResult) :- nand(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/tak.pl0000644000175000017500000000114313021324543016322 0ustar spaspa% generated: 17 November 1989 % option(s): SOURCE_TRANSFORM_1 % % tak % % Evan Tick (from Lisp version by R. P. Gabriel) % % (almost) Takeuchi function (recursive arithmetic) tak(ShowResult) :- tak(18,12,6,R), ( ShowResult = true -> write(tak(18,12,6)=R), nl ; true). tak(X,Y,Z,A):- X =< Y, Z = A. tak(X,Y,Z,A):- X > Y, X1 is X - 1, tak(X1,Y,Z,A1), Y1 is Y - 1, tak(Y1,Z,X,A2), Z1 is Z - 1, tak(Z1,X,Y,A3), tak(A1,A2,A3,A). % benchmark interface benchmark(ShowResult) :- tak(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/crypt.pl0000644000175000017500000000402213021324543016703 0ustar spaspa% crypt % % Cryptomultiplication: % Find the unique answer to: % OEE % EE % --- % EOEE % EOE % ---- % OOEE % % where E=even, O=odd. % This program generalizes easily % to any such problem. % Written by Peter Van Roy crypt(ShowResult) :- odd(A), even(B), even(C), even(E), mult([C, B, A], E, [I, H, G, F | X]), lefteven(F), odd(G), even(H), even(I), zero(X), lefteven(D), mult([C, B, A], D, [L, K, J | Y]), lefteven(J), odd(K), even(L), zero(Y), sum2([I, H, G, F], [0, L, K, J], [P, O, N, M | Z]), odd(M), odd(N), even(O), even(P), zero(Z), ( ShowResult = true -> write(' '), write(A), write(B), write(C), nl, write(' '), write(D), write(E), nl, write(F), write(G), write(H), write(I), nl, write(J), write(K), write(L), nl, write(M), write(N), write(O), write(P), nl ; true). % In the usual source this predicate is named sum. However, sum is a % language construct in NU-Prolog, and cannot be defined as a predicate. % If you try, nc comes up with an obscure error message. sum2(AL, BL, CL) :- sum2(AL, BL, 0, CL). sum2([A | AL], [B | BL], Carry, [C | CL]) :- !, X is (A + B + Carry), C is X mod 10, NewCarry is X // 10, sum2(AL, BL, NewCarry, CL). sum2([], BL, 0, BL) :- !. sum2(AL, [], 0, AL) :- !. sum2([], [B | BL], Carry, [C | CL]) :- !, X is B + Carry, NewCarry is X // 10, C is X mod 10, sum2([], BL, NewCarry, CL). sum2([A | AL], [], Carry, [C | CL]) :- !, X is A + Carry, NewCarry is X // 10, C is X mod 10, sum2([], AL, NewCarry, CL). sum2([], [], Carry, [Carry]). mult(AL, D, BL) :- mult(AL, D, 0, BL). mult([], _, Carry, [C, Cend]) :- C is Carry mod 10, Cend is Carry // 10. mult([A | AL], D, Carry, [B | BL] ) :- X is A * D + Carry, B is X mod 10, NewCarry is X // 10, mult(AL, D, NewCarry, BL). zero([]). zero([0 | L]) :- zero(L). odd(1). odd(3). odd(5). odd(7). odd(9). even(0). even(2). even(4). even(6). even(8). lefteven(2). lefteven(4). lefteven(6). lefteven(8). % benchmark interface benchmark(ShowResult) :- crypt(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/sendmore.pl0000644000175000017500000000224513021324543017363 0ustar spaspa % Cryptoaddition: % Find the unique answer to: % SEND % +MORE % ----- % MONEY % where each letter is a distinct digit. sendmore(ShowResult) :- digit(D), digit(E), D=\=E, sumdigit(0, D, E, Y, C1), digit(N), N=\=Y, N=\=E, N=\=D, digit(R), R=\=N, R=\=Y, R=\=E, R=\=D, sumdigit(C1,N, R, E, C2), digit(O), O=\=R, O=\=N, O=\=Y, O=\=E, O=\=D, sumdigit(C2,E, O, N, C3), leftdigit(S), S=\=O, S=\=R, S=\=N, S=\=Y, S=\=E, S=\=D, leftdigit(M), M=\=S, M=\=O, M=\=R, M=\=N, M=\=Y, M=\=E, M=\=D, sumdigit(C3,S, M, O, M), ( ShowResult = true -> write(' '),write(S),write(E),write(N),write(D),nl, write('+'),write(M),write(O),write(R),write(E),nl, write('-----'),nl, write(M),write(O),write(N),write(E),write(Y),nl,nl ; true), fail. sendmore(_). sumdigit(C, A, B, S, D) :- X is (C+A+B), (X<10 -> S=X, D=0 ; S is X-10, D=1 ). digit(0). digit(1). digit(2). digit(3). digit(4). digit(5). digit(6). digit(7). digit(8). digit(9). leftdigit(1). leftdigit(2). leftdigit(3). leftdigit(4). leftdigit(5). leftdigit(6). leftdigit(7). leftdigit(8). leftdigit(9). % benchmark interface benchmark(ShowResult) :- sendmore(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/SWI/0000755000175000017500000000000013021324543015651 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/SWI/HOOK.pl0000644000175000017500000000066213021324543016752 0ustar spaspa% hook file for SWI Prolog % Count is passed on the command line as the last argument (1st is 'pl') get_count(Count) :- unix(argv(L)), get_last(L, ACount), atom_codes(ACount, LCodes), number_codes(Count, LCodes). get_last([Count], Count):- !, sub_atom(Count, 0, 1, _, X), X @>= '0', X @=< '9'. get_last([_|L], Count):- get_last(L, Count). get_cpu_time(T) :- statistics(cputime, X), T is X*1000. :- initialization(q). gprolog-1.4.5/examples/ExamplesPl/SWI/MAKE_CLEAN0000755000175000017500000000002713021324543017215 0ustar spaspa#!/bin/sh rm -f [a-z]* gprolog-1.4.5/examples/ExamplesPl/SWI/MAKE_PROGS0000755000175000017500000000071313021324543017267 0ustar spaspa#!/bin/sh BENCH_PL=`cat ../PROGS` p=`(cd ..;pwd)` p1=`pwd`; for i in ${*:-$BENCH_PL} do echo $i f=$p1/$i.pl echo "#!/bin/sh" >$i echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i echo "cat $p1/HOOK.pl >>$f" >>$i echo "pl -L6000 -G6000 -T6000 -f none -g \"load_files(['$f'],[silent(true)])\" -t halt \$*" >>$i chmod a+x $i done gprolog-1.4.5/examples/ExamplesPl/.gitignore0000644000175000017500000000030713021324543017177 0ustar spaspaTO_DO BENCHING RES_C* COMPARE_BENCH BENCH_NAMES CHECK.sh STAT* boyer browse cal chat_parser crypt ham meta_qsort nand nrev poly_10 qsort queens queensn query reducer sdda sendmore tak tak_gvar zebra gprolog-1.4.5/examples/ExamplesPl/YAP/0000755000175000017500000000000013021324543015640 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/YAP/HOOK.pl0000644000175000017500000000044713021324543016742 0ustar spaspa:- use_module(library(lists)). % hook file for YAP Prolog % Count is passed on the command line as -- Count get_count(Count) :- unix(argv(L)), L = [ACount|_], atom_codes(ACount, LCodes), number_codes(Count, LCodes). get_cpu_time(T) :- statistics(runtime, [T, _]). :- initialization(q). gprolog-1.4.5/examples/ExamplesPl/YAP/MAKE_CLEAN0000755000175000017500000000002713021324543017204 0ustar spaspa#!/bin/sh rm -f [a-z]* gprolog-1.4.5/examples/ExamplesPl/YAP/MAKE_PROGS0000755000175000017500000000064113021324543017256 0ustar spaspa#!/bin/sh BENCH_PL=`cat ../PROGS` p=`(cd ..;pwd)` p1=`pwd`; for i in ${*:-$BENCH_PL} do echo $i f=$p1/$i.pl echo "#!/bin/sh" >$i echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i echo "cat $p1/HOOK.pl >>$f" >>$i echo "echo \"compile('$f'). \" | yap -- \$* 2>/dev/null" >>$i chmod a+x $i done gprolog-1.4.5/examples/ExamplesPl/tak_gvar.pl0000644000175000017500000000162013021324543017341 0ustar spaspa% generated: 17 November 1989 % option(s): SOURCE_TRANSFORM_1 % % tak % % Evan Tick (from Lisp version by R. P. Gabriel) % % (almost) Takeuchi function (recursive arithmetic) % uses global variables to tabulate results tak_gvar(ShowResult) :- init_tak_array, tak(18,12,6,R), ( ShowResult = true -> write(tak(18,12,6)=R), nl ; true). init_tak_array:- g_assign(tak,g_array_auto(20,g_array_auto(20,g_array_auto(20,null)))). tak(X,Y,Z,A):- g_read(tak(X,Y,Z),A1), (integer(A1) -> A=A1 ; tak1(X,Y,Z,A), g_assign(tak(X,Y,Z),A)). tak1(X,Y,Z,A):- X =< Y, Z = A. tak1(X,Y,Z,A):- X > Y, X1 is X - 1, tak(X1,Y,Z,A1), Y1 is Y - 1, tak(Y1,Z,X,A2), Z1 is Z - 1, tak(Z1,X,Y,A3), tak(A1,A2,A3,A). % benchmark interface benchmark(ShowResult) :- tak_gvar(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/0000755000175000017500000000000013021324543016542 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/BINPROLOG/HOOK.pl0000644000175000017500000000035013021324543017635 0ustar spaspa% hook file for BinProlog % Count is passed as a fact at the end of the source get_count(Count) :- count(Count). get_cpu_time(T) :- statistics(runtime,[_,T]). % no initialization, script executes q/0 after consult main :- q. gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/MAKE_CLEAN0000755000175000017500000000002713021324543020106 0ustar spaspa#!/bin/sh rm -f [a-z]* gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/MAKE_PROGS0000755000175000017500000000073713021324543020166 0ustar spaspa#!/bin/sh BENCH_PL=`cat ../PROGS` p=`(cd ..;pwd)` p1=`pwd`; for i in ${*:-$BENCH_PL} do echo $i f=$p1/$i.pl echo "#!/bin/sh" >$i echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i echo "cat $p1/HOOK.pl >>$f" >>$i echo "echo \"count(\${1:-1}). \" >>$f" >>$i echo "echo \"['$f']. \" | bp -h 6000 -t 6000 -s 6000 2>/dev/null" >>$i chmod a+x $i done gprolog-1.4.5/examples/ExamplesPl/SICSTUS/0000755000175000017500000000000013021324543016344 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/SICSTUS/HOOK.pl0000644000175000017500000000043213021324543017440 0ustar spaspa% hook file for SICStus Prolog % Count is passed on the command line as -a Count get_count(Count) :- current_prolog_flag(argv, L), L = [ACount|_], atom_codes(ACount, LCodes), number_codes(Count, LCodes). get_cpu_time(T) :- statistics(runtime, [T, _]). :- initialization(q). gprolog-1.4.5/examples/ExamplesPl/SICSTUS/MAKE_CLEAN0000755000175000017500000000002713021324543017710 0ustar spaspa#!/bin/sh rm -f [a-z]* gprolog-1.4.5/examples/ExamplesPl/SICSTUS/MAKE_PROGS0000755000175000017500000000102213021324543017754 0ustar spaspa#!/bin/sh BENCH_PL=`cat ../PROGS` p=`(cd ..;pwd)` p1=`pwd`; if test "$NATIVE" = ""; then mode=compactcode else mode=fastcode fi for i in ${*:-$BENCH_PL} do echo $i f=$p1/$i.pl echo "#!/bin/sh" >$i echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i echo "cat $p1/HOOK.pl >>$f" >>$i echo "echo \"prolog_flag(compiling,_,$mode), compile('$f'). \" | sicstus -a \$* 2>/dev/null" >>$i chmod a+x $i done gprolog-1.4.5/examples/ExamplesPl/query.pl0000644000175000017500000000341313021324543016712 0ustar spaspa% query % % David H. D. Warren % % query population and area database to find countries % of approximately equal population density query(true) :- query_show, fail ; true. query(fail) :- query_silent, fail ; true. query_show :- query1(C1, D1, C2, D2), write([C1-D1, C2-D2]), nl. query_silent :- query1(_C1, _D1, _C2, _D2). query1(C1, D1, C2, D2) :- density(C1, D1), density(C2, D2), D1 > D2, T1 is 20 * D1, T2 is 21 * D2, T1 < T2. density(C, D) :- pop(C, P), area(C, A), D is P * 100 // A. % populations in 100000s pop('china', 8250). pop('india', 5863). pop('ussr', 2521). pop('usa', 2119). pop('indonesia', 1276). pop('japan', 1097). pop('brazil', 1042). pop('bangladesh', 750). pop('pakistan', 682). pop('w_germany', 620). pop('nigeria', 613). pop('mexico', 581). pop('uk', 559). pop('italy', 554). pop('france', 525). pop('philippines', 415). pop('thailand', 410). pop('turkey', 383). pop('egypt', 364). pop('spain', 352). pop('poland', 337). pop('s_korea', 335). pop('iran', 320). pop('ethiopia', 272). pop('argentina', 251). % areas in 1000s of square miles area('china', 3380). area('india', 1139). area('ussr', 8708). area('usa', 3609). area('indonesia', 570). area('japan', 148). area('brazil', 3288). area('bangladesh', 55). area('pakistan', 311). area('w_germany', 96). area('nigeria', 373). area('mexico', 764). area('uk', 86). area('italy', 116). area('france', 213). area('philippines', 90). area('thailand', 200). area('turkey', 296). area('egypt', 386). area('spain', 190). area('poland', 121). area('s_korea', 37). area('iran', 628). area('ethiopia', 350). area('argentina', 1080). % benchmark interface benchmark(ShowResult) :- query(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/PROGS0000644000175000017500000000016413021324543016025 0ustar spaspaboyer browse cal chat_parser crypt ham meta_qsort nand nrev poly_10 queens queensn reducer #sdda sendmore tak zebra gprolog-1.4.5/examples/ExamplesPl/WAMCC/0000755000175000017500000000000013021324543016041 5ustar spaspagprolog-1.4.5/examples/ExamplesPl/WAMCC/HOOK.pl0000644000175000017500000000035213021324543017136 0ustar spaspa% hook file for Wamcc % Count is passed as the first argument get_count(Count) :- unix(argv(L)), L = [ACount|_], name(ACount, LCodes), name(Count, LCodes). get_cpu_time(T) :- statistics(runtime, [T, _]). :- main. :- q, halt. gprolog-1.4.5/examples/ExamplesPl/WAMCC/MAKE_CLEAN0000755000175000017500000000002713021324543017405 0ustar spaspa#!/bin/sh rm -f [a-z]* gprolog-1.4.5/examples/ExamplesPl/WAMCC/MAKE_PROGS0000755000175000017500000000051213021324543017454 0ustar spaspa#!/bin/sh BENCH_PL=`cat ../PROGS` p=`(cd ..;pwd)` p1=`pwd`; for i in ${*:-$BENCH_PL} do echo $i f=$i.pl sed -e 's/^:- include(common)\.//' $p/$i.pl >$f sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f cat HOOK.pl >>$f wamcc $f w_gcc -s -o $i $i.c -lwamcc rm -f $i.c $i.h $i.usr done gprolog-1.4.5/examples/ExamplesPl/meta_qsort.pl0000644000175000017500000000557313021324543017734 0ustar spaspa% generated: 8 March 1990 % option(s): % % meta_qsort % % Ralph M. Haygood % % meta-interpret Warren benchmark qsort % % For any meta-variable ~X~, interpret(~X~) behaves as if % % interpret(~X~):- ~X~. % % Thus, for example, interpret((foo(X), bar(X), !)) behaves as if % % interpret((foo(X), bar(X), !)):- foo(X), bar(X), !. % % Note that though ~X~ may contain cuts, those cuts cannot escape from % interpret(~X~) to effect the parent goal; interpret(!) is equivalent % to true. % % Cuts inside ~X~ are executed according to the rule that conjunction, % disjunction, and if-then-else are transparent to cuts, and any other % form is transparent to cuts if and only if it can be macro-expanded % into a form involving only these three without interpret/1. If-then % and negation are the only such other forms currently recognized; ( A % -> B) is equivalent to ( A -> B ; fail ), and \+ A is equivalent to % ( A -> fail ; true ). meta_qsort(ShowResult) :- interpret(qsort(R)), ( ShowResult = true -> write(R), nl ; true). interpret(Goal):- interpret(Goal, Rest), (nonvar(Rest), !, interpret(Rest) ; true). interpret(G, _):- var(G), !, fail. interpret((A, B), Rest):- !, interpret(A, Rest0), (nonvar(Rest0) -> Rest = (Rest0, B) ; interpret(B, Rest)). interpret((A ; B), Rest):- !, interpret_disjunction(A, B, Rest). interpret((A -> B), Rest):- !, interpret_disjunction((A -> B), fail, Rest). interpret(\+A, Rest):- !, interpret_disjunction((A -> fail), true, Rest). interpret(!, true):- !. interpret(G, _):- integer(G), !, fail. interpret(G, _):- is_built_in(G), !, interpret_built_in(G). interpret(G, _):- define(G, Body), interpret(Body). interpret_disjunction((A -> B), _, Rest):- interpret(A, Rest0), !, (nonvar(Rest0) -> Rest = (Rest0 -> B) ; interpret(B, Rest)). interpret_disjunction((_ -> _), C, Rest):- !, interpret(C, Rest). interpret_disjunction(A, _, Rest):- interpret(A, Rest). interpret_disjunction(_, B, Rest):- interpret(B, Rest). is_built_in(true). is_built_in(_=<_). is_built_in(write(_)). interpret_built_in(true). interpret_built_in(X=$i echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i echo "cat $p1/HOOK.pl >>$f" >>$i echo "echo \"asserta(count(\${1:-1})), ['$f'], q, halt. \" | xsb --noprompt --quietload --nobanner 2>/dev/null" >>$i chmod a+x $i done gprolog-1.4.5/examples/ExamplesPl/nrev.pl0000644000175000017500000000243613021324543016523 0ustar spaspa/* The naive reverse benchmark */ nrev(ShowResult) :- bench(2500, ShowResult). nrev([],[]). nrev([X|Rest],Ans):- nrev(Rest,L), append(L,[X],Ans). my_append([],L,L). my_append([X|L1],L2,[X|L3]):- my_append(L1,L2,L3). /* commented since it is defined in common.pl get_cpu_time(T) :- statistics(runtime,[T|_]). */ bench(Count, ShowResult):- get_cpu_time(T0), dodummy(Count), get_cpu_time(T1), dobench(Count), get_cpu_time(T2), ( ShowResult = true -> report(Count,T0,T1,T2) ; true). dobench(Count):- data(List), repeat(Count), nrev(List,_), fail. dobench(_). dodummy(Count):- data(List), repeat(Count), dummy(List,_), fail. dodummy(_). dummy(_,_). data(X):- data(X,30). data([],0). data([a|Y],N):- N > 0, N1 is N-1, data(Y,N1). repeat(_N). repeat(N):- N > 1, N1 is N-1, repeat(N1). report(Count,T0,T1,T2) :- Time1 is T1-T0, Time2 is T2-T1, (Time2 =< Time1 -> Time = 1 ; Time is Time2-Time1 /* Time spent on nreving lists */ ), Lips is (496*Count*1000)//Time, write(Lips), write(' lips for '), write(Count), write(' iterations taking '), write(Time), write(' msec ('), write(Time2-Time1), write(')'), nl. % benchmark interface benchmark(ShowResult) :- nrev(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/cal.pl0000644000175000017500000000564713021324543016317 0ustar spaspa/* Calendar program: This algorithm was published in comp.programming and comes from Andy Lowry, lowry@watson.ibm.com, (914) 784-7925 IBM Research, P.O. Box 704, Yorktown Heights, NY 10598 % Original Prolog version by Peter Ludemann, % optimized for BinProlog by Paul Tarau. */ % Last 10000 FoolsDays arithmetic benchmark: cal(ShowResult):- N = 10000, day_of_week(1993,4,9,Day), ( ShowResult = true -> write('April 9, 1993 is: '), write(Day), write(' fools_days = '), write(N), nl ; true), empty_loop(N), full_loop(N). range(Min,Min,Max):- Min=>1, N is M<<1, !, poly_exp(M, Poly, Part), poly_mul(Part, Part, Result). poly_exp(N, Poly, Result) :- M is N-1, poly_exp(M, Poly, Part), poly_mul(Poly, Part, Result). % polynomial multiplication poly_mul(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !, term_mul(Terms1, Terms2, Terms). poly_mul(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :- Var1 less_than Var2, !, mul_through(Terms1, poly(Var2,Terms2), Terms). poly_mul(P, poly(Var,Terms2), poly(Var,Terms)) :- !, mul_through(Terms2, P, Terms). poly_mul(poly(Var,Terms1), C, poly(Var,Terms)) :- !, mul_through(Terms1, C, Terms). poly_mul(C1, C2, C) :- C is C1*C2. term_mul([], _, []) :- !. term_mul(_, [], []) :- !. term_mul([Term|Terms1], Terms2, Terms) :- single_term_mul(Terms2, Term, PartA), term_mul(Terms1, Terms2, PartB), term_add(PartA, PartB, Terms). single_term_mul([], _, []) :- !. single_term_mul([term(E1,C1)|Terms1], term(E2,C2), [term(E,C)|Terms]) :- E is E1+E2, poly_mul(C1, C2, C), single_term_mul(Terms1, term(E2,C2), Terms). mul_through([], _, []) :- !. mul_through([term(E,Term)|Terms], Poly, [term(E,NewTerm)|NewTerms]) :- poly_mul(Term, Poly, NewTerm), mul_through(Terms, Poly, NewTerms). % benchmark interface benchmark(ShowResult) :- poly_10(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/zebra.pl0000644000175000017500000000304413021324543016650 0ustar spaspa% Where does the zebra live? % Puzzle solution written by Claude Sammut. zebra(ShowResult) :- houses(Houses), mymember(house(red, english, _, _, _), Houses), mymember(house(_, spanish, dog, _, _), Houses), mymember(house(green, _, _, coffee, _), Houses), mymember(house(_, ukrainian, _, tea, _), Houses), right_of(house(green,_,_,_,_), house(ivory,_,_,_,_), Houses), mymember(house(_, _, snails, _, winstons), Houses), mymember(house(yellow, _, _, _, kools), Houses), Houses = [_, _, house(_, _, _, milk, _), _,_], Houses = [house(_, norwegian, _, _, _)|_], next_to(house(_,_,_,_,chesterfields), house(_,_,fox,_,_), Houses), next_to(house(_,_,_,_,kools), house(_,_,horse,_,_), Houses), mymember(house(_, _, _, orange_juice, lucky_strikes), Houses), mymember(house(_, japanese, _, _, parliaments), Houses), next_to(house(_,norwegian,_,_,_), house(blue,_,_,_,_), Houses), mymember(house(_, _, zebra, _, _), Houses), mymember(house(_, _, _, water, _), Houses), ( ShowResult = true -> print_houses(Houses) ; true). houses([ house(_, _, _, _, _), house(_, _, _, _, _), house(_, _, _, _, _), house(_, _, _, _, _), house(_, _, _, _, _) ]). right_of(A, B, [B, A | _]). right_of(A, B, [_ | Y]) :- right_of(A, B, Y). next_to(A, B, [A, B | _]). next_to(A, B, [B, A | _]). next_to(A, B, [_ | Y]) :- next_to(A, B, Y). mymember(X, [X|_]). mymember(X, [_|Y]) :- mymember(X, Y). print_houses([]). print_houses([A|B]) :- write(A), nl, print_houses(B). % benchmark interface benchmark(ShowResult) :- zebra(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesPl/ham.pl0000644000175000017500000000176613021324543016323 0ustar spaspaham(true) :- ham_show, fail ; true. ham(false) :- ham_silent, fail ; true. ham_show :- ham1(X), write(X), nl. ham_silent :- ham1(_). ham1(X):- cycle_ham([a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t],X). cycle_ham([X|Y],[X,T|L]):- chain_ham([X|Y],[],[T|L]), edge(T,X). chain_ham([X],L,[X|L]). chain_ham([X|Y],K,L):- del(Z,Y,T), edge(X,Z), chain_ham([Z|T],[X|K],L). del(X,[X|Y],Y). del(X,[U|Y],[U|Z]):- del(X,Y,Z). edge(X,Y):- connect(X,L), el(Y,L). el(X,[X|_]). el(X,[_|L]):- el(X,L). connect(a,[b,j,k]). connect(b,[a,c,p]). connect(c,[b,d,l]). connect(d,[c,e,q]). connect(e,[d,f,m]). connect(f,[e,g,r]). connect(g,[f,h,n]). connect(h,[i,g,s]). connect(i,[j,h,o]). connect(j,[a,i,t]). connect(k,[o,l,a]). connect(l,[k,m,c]). connect(m,[l,n,e]). connect(n,[m,o,g]). connect(o,[n,k,i]). connect(p,[b,q,t]). connect(q,[p,r,d]). connect(r,[q,s,f]). connect(s,[r,t,h]). connect(t,[p,s,j]). % benchmark interface benchmark(ShowResult) :- ham(ShowResult). :- include(common). gprolog-1.4.5/examples/ExamplesC/0000755000175000017500000000000013021324543015016 5ustar spaspagprolog-1.4.5/examples/ExamplesC/Makefile0000644000175000017500000000041313021324543016454 0ustar spaspaGPLC = gplc #CFLAGS='-Wall -g' CFLAGS=-O EXECS=examp new_main all: $(EXECS) examp: examp.pl examp_c.c $(GPLC) -C '$(CFLAGS)' examp.pl examp_c.c new_main: new_main.pl new_main_c.c $(GPLC) -C '$(CFLAGS)' new_main.pl new_main_c.c clean: rm -f $(EXECS) *.exe gprolog-1.4.5/examples/ExamplesC/README0000644000175000017500000000310613021324543015676 0ustar spaspa Prolog <-> C interface examples This directory contains examples presented in the documentation. To build: make examp.pl / examp_c.c: examples calling C from Prolog and C from Prolog new_main.pl / new_main_c.c: example defining a new main function. WINDOWS ------- In Microsoft Windows if you intend to use the gplc compiler as described in the documentation you need to be certain the following conditions are met: - for the port compiled with MS Visual C++ you need the 'cl' compiler (must be available from your PATH). - for the port compiled with MinGW you need the MinGW gcc toolchain (must be available from your PATH). - For any version you need the MinGW assembler (called as.exe). Copy it under a directory somewhere inside your PATH under the name mingw-as.exe. A version can be found at: http://gprolog.org/mingw-as.exe It is a good idea to read src/WNIDOWS (and maybe src/WINDOWS64) file before. Observing these needs you'll also will be able to do the mixed language programming, as the examples included in the ExamplesC directory. However you'll need to write your own Makefile as the one provided is for gplc calling 'gcc' and the options passed by GNU Prolog will not work, here is an example for nmake and MSVC++ compiler: GPLC = gplc CFLAGS=-c -W4 EXECS=examp.exe new_main.exe .SUFFIXES: .obj .c .wam .pl .pl.obj: $(GPLC) $(CFLAGS) $< .c.obj: $(GPLC) $(CFLAGS) $< all: $(EXECS) examp.exe: examp.obj examp_c.obj $(GPLC) -o $@ $** new_main.exe: new_main.obj new_main_c.obj $(GPLC) -o $@ $** clean: rm -f $(EXECS) *.obj gprolog-1.4.5/examples/ExamplesC/.gitignore0000644000175000017500000000001713021324543017004 0ustar spaspaexamp new_main gprolog-1.4.5/examples/ExamplesC/new_main.pl0000644000175000017500000000560213021324543017153 0ustar spaspa/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : foreign facility test * * File : new_main.pl * * Descr.: test file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ parent(bob, mary). parent(jane, mary). parent(mary, peter). parent(paul, peter). parent(peter, john). anc(X, Y):- parent(X, Y). anc(X, Z):- parent(X, Y), anc(Y, Z). gprolog-1.4.5/examples/ExamplesC/examp.pl0000644000175000017500000000610013021324543016462 0ustar spaspa/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : foreign facility test * * File : examp.pl * * Descr.: test file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- foreign(first_occurrence(+string, +char, -positive)). :- foreign(occurrence(+string, +char, -positive), [choice_size(1)]). :- foreign(occurrence2(+string, +char, -positive), [choice_size(1)]). :- foreign(char_ascii(?char, ?code)). :- foreign(char_ascii2(?char, ?code)). :- foreign(my_call(term)). :- foreign(my_call2(term)). :- foreign(all_op(term)). gprolog-1.4.5/examples/ExamplesC/examp_c.c0000644000175000017500000002200413021324543016574 0ustar spaspa/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : foreign facility test * * File : examp_c.c * * Descr.: test file - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include #include "gprolog.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * FIRST_OCCURRENCE * * * *-------------------------------------------------------------------------*/ PlBool first_occurrence(char *str, PlLong c, PlLong *pos) { char *p; p = strchr(str, c); if (p == NULL) /* C does not appear in A */ return PL_FALSE; /* fail */ *pos = p - str; /* set the output argument */ return PL_TRUE; /* succeed */ } /*-------------------------------------------------------------------------* * OCCURRENCE * * * *-------------------------------------------------------------------------*/ PlBool occurrence(char *str, PlLong c, PlLong *pos) { char **info_pos; char *p; info_pos = Pl_Get_Choice_Buffer(char **); /* recover the buffer */ if (Pl_Get_Choice_Counter() == 0) /* first invocation ? */ *info_pos = str; p = strchr(*info_pos, c); if (p == NULL) /* C does not appear */ { Pl_No_More_Choice(); /* remove choice-point */ return PL_FALSE; /* fail */ } *pos = p - str; /* set the output argument */ *info_pos = p + 1; /* update next starting pos */ return PL_TRUE; /* succeed */ } /*-------------------------------------------------------------------------* * OCCURRENCE2 * * * *-------------------------------------------------------------------------*/ PlBool occurrence2(char *str, PlLong c, PlLong *pos) { char **info_pos; char *p; info_pos = Pl_Get_Choice_Buffer(char **); /* recover the buffer */ if (Pl_Get_Choice_Counter() == 0) /* first invocation ? */ { p = strchr(str, c); if (p == NULL) /* C does not appear at all */ { Pl_No_More_Choice(); /* remove choice-point */ return PL_FALSE; /* fail */ } *info_pos = p; } /* info_pos = an occurrence */ *pos = *info_pos - str; /* set the output argument */ p = strchr(*info_pos + 1, c); if (p == NULL) /* no more occurrence */ Pl_No_More_Choice(); /* remove choice-point */ else *info_pos = p; /* else update next solution */ return PL_TRUE; /* succeed */ } /*-------------------------------------------------------------------------* * CHAR_ASCII * * * *-------------------------------------------------------------------------*/ PlBool char_ascii(PlFIOArg *c, PlFIOArg *ascii) { if (!c->is_var) /* Char is not a variable */ { ascii->unify = PL_TRUE; /* enforce unif. of Code */ ascii->value.l = c->value.l; /* set Code */ return PL_TRUE; /* succeed */ } if (ascii->is_var) /* Code is also a variable */ Pl_Err_Instantiation(); /* emit instantiation_error */ c->value.l = ascii->value.l; /* set Char */ return PL_TRUE; /* succeed */ } /*-------------------------------------------------------------------------* * CHAR_ASCII2 * * * *-------------------------------------------------------------------------*/ PlBool char_ascii2(PlFIOArg *c, PlFIOArg *ascii) { if (!c->is_var) { if (!ascii->is_var) return ascii->value.l == c->value.l; ascii->value.l = c->value.l; return PL_TRUE; } if (ascii->is_var) Pl_Err_Instantiation(); c->value.l = ascii->value.l; return PL_TRUE; } /*-------------------------------------------------------------------------* * MY_CALL * * * *-------------------------------------------------------------------------*/ PlBool my_call(PlTerm goal) { PlTerm *args; int functor, arity; int result; args = Pl_Rd_Callable_Check(goal, &functor, &arity); Pl_Query_Begin(PL_FALSE); result = Pl_Query_Call(functor, arity, args); Pl_Query_End(PL_KEEP_FOR_PROLOG); if (result == PL_EXCEPTION) { PlTerm except = Pl_Get_Exception(); #if 0 Pl_Exec_Continuation(Pl_Find_Atom("throw"), 1, &except); #else Pl_Throw(except); #endif } return result; } /*-------------------------------------------------------------------------* * MY_CALL2 * * * *-------------------------------------------------------------------------*/ PlBool my_call2(PlTerm goal) { PlTerm *args; int functor, arity; args = Pl_Rd_Callable_Check(goal, &functor, &arity); Pl_Exec_Continuation(functor, arity, args); return PL_TRUE; } /*-------------------------------------------------------------------------* * ALL_OP * * * *-------------------------------------------------------------------------*/ PlBool all_op(PlTerm list) { PlTerm op[1024]; PlTerm args[3]; int n = 0; int result; Pl_Query_Begin(PL_TRUE); args[0] = Pl_Mk_Variable(); args[1] = Pl_Mk_Variable(); args[2] = Pl_Mk_Variable(); result = Pl_Query_Call(Pl_Find_Atom("current_op"), 3, args); while (result) { op[n++] = Pl_Mk_Atom(Pl_Rd_Atom(args[2])); /* arg #2 is the name of the op */ result = Pl_Query_Next_Solution(); } Pl_Query_End(PL_RECOVER); return Pl_Un_Proper_List_Check(n, op, list); } gprolog-1.4.5/examples/ExamplesC/new_main_c.c0000644000175000017500000001106513021324543017264 0ustar spaspa/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : foreign facility test * * File : new_main_c.c * * Descr.: test file - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include #include #define __GPROLOG_FOREIGN_STRICT__ #include "gprolog.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * MAIN * * * * See comments in EnginePl/main.c about the use of the wrapper function. * *-------------------------------------------------------------------------*/ static int Main_Wrapper(int argc, char *argv[]) { int func; PlTerm arg[10]; char str[100]; char *sol[100]; int i, nb_sol = 0; PlBool res; Pl_Start_Prolog(argc, argv); func = Pl_Find_Atom("anc"); for (;;) { printf("\nEnter a name (or 'end' to finish): "); fflush(stdout); if (scanf("%s", str)) /* avoid gcc warning warn_unused_result */ ; if (strcmp(str, "end") == 0) break; Pl_Query_Begin(PL_TRUE); arg[0] = Pl_Mk_Variable(); arg[1] = Pl_Mk_String(str); nb_sol = 0; res = Pl_Query_Call(func, 2, arg); while (res) { sol[nb_sol++] = Pl_Rd_String(arg[0]); res = Pl_Query_Next_Solution(); } Pl_Query_End(PL_RECOVER); for (i = 0; i < nb_sol; i++) printf(" solution: %s\n", sol[i]); printf("%d solution(s)\n", nb_sol); } Pl_Stop_Prolog(); return 0; } int main(int argc, char *argv[]) { return Main_Wrapper(argc, argv); } gprolog-1.4.5/gprolog.ico0000644000175000017500000037536513021324543013507 0ustar spaspa hf  ¨Î00 ¨%v@@ (B;€€ (F} ‡un…(  Ÿ€~ŒŽ¡‡ŠŠÿ¥ccõÅBBÒèªðîYè0Ì88Ó22ÿÿæ¥sq'ÿÿ2ÿÿÀ#ÿÿÿÿÿÿÿÿÿ2æçÿT¾¾ÿv˜˜ÿ•uuÿ°XXæÉ==™æ+ÿBÿÿ'ÿÿcÿÿ3HüäÔ<úÖÿ9üàÿ7ÿðÿ2ÿÿÿ,ÿÿÿ!ÿÿÿÿÿÿ4ääÿ™ssâé0ÿXÿÿëIB!î_*ñ{¤1ô“¸5ö§Ì7õ³à:ãÔõEæÿÿ,ÿÿÿ,ððÿºNN³æ;õ¨ÃÖÜ'Ý:"²~LV£ÿš<âþýÿÿÿŽ€€ÿÊ<<åÃÚÚÙÙÞjžy‘ÿxKáþÿÿÿÿ„ŠŠÿÆ??åÐæ!k$ïpÚ6õ¡æ7õ£å7õ£å6õ£å5ö¥åKòÎåQëÿð5üþÿÿÿÿ©bbäÓ22ÛëHo8ö±ÿHÿÿÿ%Ÿÿ!™˜ÿ,ÊÈÿ ”“ÿ+ËÉÿ¡ ÿ-ÿÿÿÿÿÿa²²ÿÑ44dÿé:(ñƒóJÿÿÿ5ýþÿ/ûýü*ôôú'ññú(îîú'ññú%òòú-êêûz••üÞ&&…ÿÞëVL8÷¸ÿ:ÿÿÿ=Êþ÷š·ÿÿ jÿlÿmÿmÿnÿjÿ,þàëRW;øÀÿ8ÿÿÿYÒÿÝ\XÿCÿÿÿºëL-.ó–ÿCÿÿÿJúÿÿ:»ÿÞ~‡–¹{{ž›nnƒ®YYiÔ11Uÿ:ÿ Nÿÿã í[–>ùÊÿDÿÿÿ:ÿÿÿ6ûÿÿ>åçÿKÐÐÿX¾¾ÿ\··÷d··ábÏÏkÿÿaÿÿæ$íX(ò†û2õ§ÿ:úÈÿ@þíÿEÿÿÿ?ÿÿÿ8ÿÿÿ7ÿÿÿHÿÿðYÿÿJåâ êA#ëLGêAoê;•ê?½í^ã$ðwÿ.ô”ÿ=ø»ÿVüàïqÿÿ+èÿÿåÞáâäé5êG ç,+æTæ)åGyåNÀÿàðøÿáÿñðàÀÃÿÇÿÀÀàþÿû( @ ÿ' þ€ú³û‰þ`ÿ4ÿÿ ÿÿÿþÿÿ î$¦srÆ«efÿÈ??ÿÚ''ÿá ÿæëìÅö ŸÿzÿSÿ2ÿ%ÿÿÿ þÚ<1ÿÿ,#ÿÿÙÿÿÿÿÿþ0ããÿMÂÂÿj¢¢ÿ‰‚‚ÿ£eeÿ·MMÿÇ==ÿÒ22òà##Óó´ÿ–ÿvÿZÿHÿ7ÿÿÿ6ÿÿGÿÿ>Bÿÿñ1ÿÿÿ#ÿÿþÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿþ)êêÿ<ÔÔÿQ¼¼ÿf¥¥ÿzÿ“vvÿª]]ÿ¾HHõÔ33ßü¿ÿˆÿ*ÿÿBÿÿ(ÿÿRÿÿKNþþÿ@þþÿ7þþþ2ÿÿÿ.ÿÿÿ+þþÿ'ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿ#òòÿ.ääÿ7ØØÿKÅÅÿ‘}}ÿþÙÿhÿÿMÿÿeþþ]ÿÿdYÿÿÿPÿÿÿHÿÿþDÿÿÿAþÿÿ>ÿÿÿ;ÿÿÿ8ÿÿÿ5ÿÿÿ2ÿÿÿ.þþÿ*ÿÿÿ'ÿÿÿ"ÿÿÿÿÿÿÿÿþùùÿ?ÖÖÿä""ñÿrÿKùÌ:õ¢Œ5ô›ÿDùÉþQþòÿUþýÿSþýÿPþýÿLþþÿIþþÿGþþÿCÿÿþ@ÿÿÿ;ÿÿÿ5ÿþÿ.ÿÿÿ(þÿÿ!þþÿÿÿÿ6ààÿìäÿAFø¿Ýã‹ãÏãáçèë=î"ïfô/óŒù<÷³ÿHûÕÿMüâÿJüèÿDøôÿ=õÿÿ5ýÿÿ0ÿþþ-ÿÿÿ#þþÿþþþn¥¥ÿÿ¤ÿåâ âBâdâ†â¨â½çÌé5Ú¬ç:ˆÿøkôÿÿ>ÿÿÿ1ÿÿþ,þÿÿÿÿþ5ààÿÉAAàÿ7ÿååáÞ1XvJ];ÿg²´ÿÂ?Ãþÿ0úÿÿ0ÿÿÿ%ÿÿÿ ùùÿžnnÿÿXåK/ÿPEˆÿë4ôÿÿ1ÿÿÿ(ÿÿÿÿÿþ‰„„ÿÿnå+ÿúÿW¦ðÿò;ýþÿ1ÿÿÿ(ÿÿÿÿÿþˆ……ÿÿoÿå)ä+ä hä{äyä yä yä yä yä yä yäyäy¢ú™x¥—ÿŠ &þß<Ïÿÿ4ÿÿÿ0þÿÿ%ÿÿÿúúÿooÿÿXå$çŽäå§ç ÿìHÿ#ðkÿ$ðlÿ$ðlÿ$ðlÿ$ðlÿ$ðlÿ$ðlÿ#ðlÿ"ðlÿ ðnÿuúÆÿçÿÿ6Ùÿÿ2ÿÿþ3ÿÿÿ,ÿÿÿÿÿþ4ààÿÃGGâÿ9å)ã Dç)ò%ñsÿQýîÿZÿÿþ5¡¡ÿ@ÇÇÿ?ÇÇÿMòòÿRÿÿÿ@ÊÊÿ6««ÿ5««ÿBààÿDÿÿÿ"§§ÿ.ÿþÿ2ÿÿÿ3ÿÿÿ/þÿÿ$þþÿÿÿÿh©©ÿÿ§ÿ åã B è*ò=ø¶ÿXÿÿþIÿÿÿBþþÿ&œÿ%££ÿ$££ÿ4êêÿ9ÿÿÿ-ÊÊÿ&««ÿ%««ÿ/ààÿ4ÿÿÿžžÿ««ÿ««ÿ+þþÿ$þþÿÿÿþAÔÔÿÛ,,êÿDÿå)ã#åÇ>÷¶ÿSÿÿþCþþÿ=ÿþÿ8ÿÿÿ#··ÿ'êêÿ#ëëÿ#ûûÿ#ÿÿÿÊÊÿ««ÿ««ÿààÿ#ÿÿÿ´´ÿ ÿÿÿÿÿÿÿÿÿ ÿÿþV¾¾ÿÑ66ýÿjÿå!âi"ïk÷Qþ÷ÿDþþÿ;þÿÿ7þÿÿ2ÿÿÿ*ÿÿÿ!ÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþúúþQÃÃÿ­^^ÿçðÿTêÿâ8ã£?÷¹ÿMÿÿÿ=ÿþÿ7ÿÿÿ0ÿÿþ»ÿÿ_‡ÿÿãþÿÿð44ÿðÿðÿðÿðÿðÿðÿðÿðÿðÿñÿô êû†ÿûÿâ  è-ÁGúÎÿHÿÿÿ:ÿÿÿ1ÿÿÿNþÿÿz£ÿì6%ÿSÉØÿ ÿ&& ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿÿâ(ê>ÍHúÖÿFÿÿÿ:ÿÿÿ0ÿÿÿ`óÿÿáÜÿ¡ÿÿÿÿâ ! é2ÅGúÑÿHÿÿþ;ÿÿÿ3ÿÿÿ"Áÿÿ*9ÿı–þ.ÿÝïá# å «Aø¾ÿLÿÿþ=ÿÿÿ6ÿÿÿ.óÿÿ}éÿÿ£ÿÇ ÿ—ÿ€ÿgÿNÿ4ÿÿÿâx*ñ~ûRþùÿCþþÿ9þÿÿ3ÿÿþ=ÿÿÿ>àÿÿ"±ÿÿ‚“•ÿ˜ww÷±ZZêÐ88ÛóÍÿ¿ÿªÿ‹ÿhÿFÿ%ÿå%âæØJû×ÿNÿÿÿ@þþÿ9ÿÿÿ5þÿÿ1ÿÿÿ.ÿÿþ)üüÿ'ööÿ(ïïÿ+ééÿ0ããÿ>××ÿ]¶¶ÿ‘‘ú¤iiôÈBBîïñÿŠÿäg è*öSþòþOÿÿÿDþþÿ>ÿÿÿ;þþÿ8ÿþÿ3ÿÿÿ-ÿÿÿ(ÿÿÿ$ÿÿÿ!ÿÿÿþþþþþÿþþÿýýÿýýÿ&ýýÿBôôÿLúú`>ÿÿYÿÿå ä†è#õCùÇÿRþõÿMþüÿIÿÿþFÿÿÿBÿÿÿ@ÿÿÿ<ÿÿÿ9ÿÿÿ6ÿÿÿ4þþÿ0ÿÿÿ-ÿÿÿ*ÿÿÿ)ÿÿÿ-þþþ8ÿÿÿJÿÿÿXþþ<hÿÿå*å ã\åÑîZô4ôÿ?÷ºÿCùÇÿFúÕÿHüâÿJýðÿLþýþLÿÿÿJÿÿÿFÿÿÿCÿÿÿ?ÿÿÿ<ÿÿÿ<ÿÿÿ>þþþHÿÿÿWÿÿñbÿÿ+nÿÿå+åã,âeâ˜ã²æÆé4ÜìKòî`ÿ'ðvÿ0óÿ7õ£ÿ=÷¹ÿCúÐÿIüçÿNþþþQÿÿÿQÿÿÿRÿÿþZÿÿÿeÿÿÒxÿÿfþõä+ã"ã4âFâXârã’æ° è*Îé8îêCÿìNÿ îaÿ)ñ~ÿ5õÿDø½ÿWüÞÿlþü±ºÿÿåVå+ååéä# ããâ%ã/ãMä tåšçÀ ç&æ è6ÿèNÿæT™âWå"å0ää äã ää71äQSå^ãÿÿÿðÿÿøÿüþ?ÿÿÿ€ÿþÿÿüÿÿþÿÿþÿÿøþüøðð?àà?ÿÿà?ÿÿà?ÿÿàÿÿðÿðÿøÿøþ?ÿ€ÿÿÿÿþÿÿÿÿ(0` ÿ#ÿ$ÿÿÿÿ ÿòÿ ïÿèÿÒÿ¡ÿbÿ-õ ÅMJóÐ::þä""ÿúÿÿÿÿÿÿÿÿîÿÃþÿvÿSÿ<ÿ"ÿ ÿÿ=ýýL1ýýÿ!üüþüüÿ+ííÿ^··ÿ“~~ÿÌBBÿùÿÿÿÿÿÿþÿýÿüÿüÿðÿ¹ÿ€ÿHÿ ÿ;ÿÿ>ÿÿi5ÿÿÿ'þþþÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿööÿ8ØØÿW¸¸ÿqÿ‘{{ÿ²YYþÖ33ÿôÿÿÿÿÿÿÿÿ÷ÿÚþºÿ›ÿ|ÿXÿ5ÿBÿÿHÿÿ®>ÿÿÿ2ÿÿÿ(ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿGÏÏÿ““ÿ´\\ÿâ$$ÿô ÿ÷ þúÿþÿÿÿÿÿÿîÿsþ ÿÿOÿÿµFÿÿÿ;ÿÿÿ3ÿÿÿ-ÿÿÿ)ÿÿÿ&ÿÿÿ#ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿúúÿ)ççÿ;ÓÓÿQ½½ÿl¥¥ÿ”~~þÎ@@ÿÿÿÿöþ¤ÿÿSÿÿ\ÿÿVÿÿçMÿÿÿCÿÿÿ=ÿÿÿ9ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿ.ÿÿÿ,ÿÿÿ*ÿÿÿ'ÿÿÿ%ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ ÿÿÿÿÿÿ&øøÿ®aaþ÷ ÿÿïþ&ÿ\ÿÿ\ÿÿöSÿÿþLÿÿÿGÿÿÿCÿÿÿAÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ7ÿÿÿ5ÿÿÿ3ÿÿÿ1ÿÿÿ.ÿÿÿ+ÿÿÿ)ÿÿÿ&ÿÿÿ%ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿ7ßßþâ%%ÿÿöþ0ÿZÿÿeÿÿE]þûÿ]ÿÿþXÿÿÿTÿÿÿPÿÿÿMÿÿÿKÿÿÿIÿÿÿGÿÿÿDÿÿÿBÿÿÿ@ÿÿÿ?ÿÿÿ=ÿÿÿ:ÿÿÿ9ÿÿÿ7ÿÿÿ4ÿÿÿ0ÿÿÿ-ÿÿÿ*ÿÿÿ&ÿÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÓ77ÿÿÿÿaÿÿé)U é-ÿïfÿ3õÿIûÜÿYÿÿÿ\ÿÿÿZÿÿÿVÿÿÿTÿÿÿQþþÿOÿÿÿMÿÿÿKÿÿÿIÿÿÿGÿÿÿDÿÿÿAÿÿÿ;ÿÿÿ9ÿÿÿ4ÿÿÿ/ÿÿÿ+ÿÿÿ'ÿÿÿ"ÿÿÿþþÿÿÿÿ&ððþíÿþÈÿÿåä†äÙã÷ãÿãÿçÿê8ÿî^ÿ+òÿ7õŸÿ@ø½ÿKûÞÿUþüÿZÿÿÿYÿÿÿTÿÿÿNÿÿÿGþÿÿ@ÿþÿ:ÿÿÿ5ÿÿÿ1ÿÿÿ.ÿÿÿ*ÿÿÿ$ÿÿÿÿÿÿÿÿÿ]ÀÀÿÿÿÿ?å%å%åFå~åºåïä ûäüäýäþäÿçÿíOÿ+ò‰ÿ=ùÃÿJüûÿEûÿÿ<ýÿÿ9ÿÿÿ2ÿÿÿ2ÿÿÿ/ÿÿÿ*ÿÿÿ#ÿÿÿþþÿ ÿÿÿÄNNÿÿëåå3 å!å<åUåtä ›äÈäîîÿ:²ÿÿÿz—ÿÿÿÿþ,ÿÿÿ2ÿÿÿ2ÿÿÿ/ÿÿÿ(ÿÿÿÿÿÿÿÿÿ]¹¹þþÿÿ0å ñ,ÿfâÞÿ½ÿýÿþvÚÿþ0þÿÿ3ÿÿÿ0ÿÿÿ+ÿÿÿ"ÿÿÿÿÿÿ4ââÿøÿÿqÿåRNÿ ÿÿ2ýÿÿ1þÿÿ1ÿÿÿ-ÿÿÿ%ÿÿÿÿÿÿúúÿô þÿ•ÿ4*ÿÿ8éÿÿ1ÿÿÿ0ÿÿÿ-ÿÿÿ&ÿÿÿÿÿÿÿÿÿñÿÿªÿÿÿ5ÿýÿÿ<þÿÿ1ÿÿÿ0ÿÿÿ-ÿÿÿ&ÿÿÿÿÿÿÿÿÿñÿÿ©å+ÿmeÿÖÈìÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ,ÿÿÿ$ÿÿÿÿÿÿùùÿô þÿ“å(å,.å%¯åýåúåúåúåúåúåúåúåúåúåúåúå úåúåúãúÿÿÿúÿÿÿúÿüÿþ1Ýÿþ1ÿÿÿ3ÿÿÿ0ÿÿÿ*ÿÿÿ!ÿÿÿÿÿÿ6ààÿøÿÿnÿå&å'\äÔãÿæÿìKþ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿ ïbÿïbÿïbÿïcÿîXÿ½ÿÿÿ·ÿÿÿSºÿÿ2ïÿÿ3ÿÿÿ3þÿÿ3ÿÿÿ/ÿÿÿ'ÿÿÿÿÿÿÿÿÿc´´þþÿÿ)å,ä!®å ÿ è#þ<øºÿ^ÿÿÿ[ÿÿÿXÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿVÿÿÿSÿÿÿOÿÿÿIÿÿÿAÿÿÿ9þþÿ7ÿÿÿ3ÿÿÿ2ÿÿÿ3ÿÿÿ4ÿÿÿ1ÿÿÿ+ÿÿÿ"ÿÿÿÿÿÿ ÿÿÿÌCCÿÿâå å0 åÒå ÿ8ö¨þYÿþÿWÿÿÿOþþÿLÿÿÿIÿÿÿHÿÿÿ/§§ÿ>ààÿBïïÿCññÿGÿÿÿ7ÉÉÿ,ŸŸÿ,ŸŸÿ+ŸŸÿCûûÿ+§§ÿ:ïïÿ;ÿÿÿ8ÿÿÿ4ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ0ÿÿÿ+ÿÿÿ$ÿÿÿÿÿÿÿÿÿm®®ÿÿÿÿ2äÂå ÿCúÌÿYÿÿÿOþþÿIÿÿÿDÿÿÿ@ÿÿÿ=ÿÿÿ<ÿÿÿ&§§ÿ$¡¡ÿ&««ÿ)¶¶ÿ:ÿÿÿ-ÇÇÿ#››ÿ#››ÿ#››ÿ8ûûÿ$§§ÿ’’ÿ››ÿ$ÃÃÿ/ÿÿÿ.ÿÿÿ.ÿÿÿ-ÿÿÿ(ÿÿÿ#ÿÿÿþþÿÿÿÿ.êêþòÿþ¾ÿÿå"“å ÿFùÍþXÿÿÿLþþÿEÿÿÿ?ÿÿÿ<ÿÿÿ:ÿÿÿ7ÿÿÿ3ÿÿÿ§§ÿ’’ÿ››ÿ¨¨ÿ,ÿÿÿ%ÙÙÿ »»ÿ »»ÿ »»ÿ+üüÿ§§ÿ(ïïÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ'ÿÿÿ%ÿÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿ#ûûÿä""ÿÿúÿå&äô!ïiþYÿÿÿMÿÿÿCÿÿÿ>ÿÿÿ:ÿÿÿ8ÿÿÿ4ÿÿÿ.ÿÿÿ*ÿÿÿ!ààÿ!úúÿ ÿÿÿÿÿÿÿÿÿííÿßßÿßßÿßßÿþþÿÙÙÿøøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿLÊÊþëÿÿðþ&ÿä –æÿ]ÿÿÿQÿÿÿEÿÿÿ>ÿÿÿ:ÿÿÿ9ÿÿÿ3ÿÿÿ/ÿÿÿ*ÿÿÿ#ÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ1ïïÿÃJJþüÿÿåþÿåÐäÿ*ó…ÿZÿÿÿJÿÿÿ?ÿÿÿ:ÿÿÿ7ÿÿÿ3þÿÿ/ÿÿÿ1ÿÿÿ4¹ÿÿ¡ÿÿÿœÿÿÿš„„ÿšvvÿ™vvÿ˜vvÿ˜vvÿ™vvÿ™vvÿ™vvÿ™vvÿ™vvÿ™vvÿ™vvÿ˜vvÿ˜vvÿ˜wwÿ©eeþÚ00ÿÿÿÿñþ„ÿÿå'Bå ÿFùÆÿSþþÿFÿÿÿ<ÿÿÿ8ÿÿÿ2ÿÿÿ/ÿÿÿ4þÿþ $ÿÿÿýÿÿÿûÿÿÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿûÿßÿbÿå!lå ÿOüâÿOÿÿÿBÿÿÿ;ÿÿÿ6ÿÿÿ0ÿÿÿ0ÿÿÿ­ôÿþvÿôÿ:ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿå†æ ÿTýòÿNÿÿÿAÿÿÿ:ÿÿÿ5ÿÿÿ/ÿÿÿ2ÿÿÿôÿÿÿÿÿÿzåŠæ þTþóÿNÿÿÿBÿÿÿ:ÿÿÿ5ÿÿÿ/ÿÿÿ2üÿÿ=>ÿÿ88ÿOå rå ÿPüæÿOÿÿÿBÿÿÿ;ÿÿÿ6ÿÿÿ0ÿÿÿ/üÿÿÿÿ)'ÿ´ÿå&Må ÿIúÏÿQÿþÿFÿÿÿ=ÿÿÿ8ÿÿÿ2ÿÿÿ0þÿÿTÊÿþþöÿþÿÿÿ¼þOÿå7äÿ4õþXÿÿÿJÿÿÿ?ÿÿÿ9ÿÿÿ5ÿÿÿ2þÿÿ-ÿÿÿ‚ÿÿþ¯Èÿÿÿÿ óÿÿÿÿÞÿ·ÿþeÿKÿ3ÿäº é+ÿ`ÿÿÿOþþÿDÿÿÿ<ÿÿÿ8ÿÿÿ2ÿÿÿ/ÿÿÿ0ÿÿÿ0ýÿÿ/ûÿÿ2çúÿt®¬ÿ¥qqÿÔ99ÿÿÿÿÿÿþÿýÿüþûÿÝÿ¦ÿgÿ-ÿå%$ãÿ1õ›þXÿÿÿLÿÿÿAÿÿÿ;ÿÿÿ7ÿÿÿ4ÿÿÿ2ÿÿÿ/ÿÿÿ.þþÿ*ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿ*ïïÿDÒÒÿ`³³ÿ|••ÿ›ssþ¼OOÿÝ,,ÿû ÿÿÿÿÿÿíÿÍÿ‡ÿå2å´æÿRüçþTÿÿÿKþþÿAÿÿÿ=ÿÿÿ:ÿÿÿ8ÿÿÿ7ÿÿÿ1ÿÿÿ.ÿÿÿ*ÿÿÿ%ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿ&øøÿWÄÄÿŽŠŠÿÂOOÿëÿç_Rÿÿå4 äñ é(ÿTþøÿUÿÿÿLÿÿÿEÿÿÿAÿÿÿ=ÿÿÿ;ÿÿÿ:ÿÿÿ7ÿÿÿ4ÿÿÿ0ÿÿÿ-ÿÿÿ)ÿÿÿ'ÿÿÿ%ÿÿÿ#ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ÿÿÿ.ÿÿþJôôÿMÿÿHXÿÿå*å)äñèÿMûÜþXÿÿÿRÿÿÿLþþÿHÿÿÿEÿÿÿBÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ:ÿÿÿ7ÿÿÿ5ÿÿÿ2ÿÿÿ1ÿÿÿ.ÿÿÿ-ÿÿÿ*ÿÿÿ(ÿÿÿ'ÿÿÿ%ÿÿÿ%ÿÿÿ%ÿÿÿ+ÿÿÿ5ÿÿÿ?ÿÿþOÿÿö[ÿÿå*å(äèå ÿïbþTÿûÿ^ÿÿÿWÿÿÿRÿÿÿOÿÿÿMÿÿÿKÿÿÿIÿÿÿFÿÿÿDÿÿÿBÿÿÿAÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ7ÿÿÿ5ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ4ÿÿÿ8ÿÿÿ?ÿÿÿKÿÿÿXÿÿæ^ÿÿ`ÿÿå+ååRå#¢ä öäÿìLÿ/óÿ<÷±ÿDøÅÿJúÚÿQýïÿVÿÿÿXÿÿÿUÿÿÿSÿÿÿOÿÿÿMÿÿÿJÿÿÿHÿÿÿFÿÿÿDÿÿÿBÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ>ÿÿÿBÿÿÿJÿÿÿSÿÿÿ]ÿÿ°å'ä$äöäÿäÿåÿåÿæ ÿæ ÿé8ÿ#ðtÿ7õ«ÿLüçÿZÿÿÿ\ÿÿÿYÿÿÿVÿÿÿSþÿÿPÿþÿNÿÿÿLÿÿÿJÿÿÿIÿÿÿHÿÿÿIÿÿÿMÿÿÿSÿÿÿ]ÿÿÿeÿÿ¥pÿÿå0!å%Dådå‰å§åÅä åäÿäÿãÿäÿç ÿê@ÿ!îeÿ-ò‡ÿ:õ©ÿBøÄÿLûãÿVþÿÿYÿÿÿYÿÿÿVÿÿÿVÿÿÿYþþÿ_ÿÿþgÿÿÿnÿÿ[wÿÿå%å$å \å—åÑåúä ûåüäþäþäÿäÿåÿìZÿ/ò’ÿEùÍÿYþûÿcþûÿjþýþrþþÿwþþ8åQå-å#-åGå]åƒå­ä Ôäþäÿãÿäÿæÿé=þëaþ!í|í çWå* åDåyå²å%åå2êäCóäUà åÆåå: åGåX+åbÿÿÿÿÿÿø?ÿÿÿÿüÿÿÿÿþÿÿÿÿÿÿÿÿÿ€ÿÿÀÿÿàÿÿðÿø?ÿø?ÿÿàÿÿÿÀÿÿÿÿÿÿÿÿ€ÿÿÿÿÀÿÿÿÿÀÿÿÿÿ€ÿøÿàÿ€ÿ?þ?üüÿøÿøÿøÿøÿÿÿÿðÿÿÿÿðÿÿÿÿøÿÿÿÿøÿÿÿÿøÿÿÿøÿÿüÿüÿþÿÿÿÿ€ÿÿÀÿÿøÿÿÿ€ÿÿÿÿÿÿÿþ?ÿÿÿÿüÿÿÿÿÿÿ(@€ e¼˜ l¶þòÿæêδ®ˆ©UÖ+Ê¢P ÿøÿÿÿÿÿÿÿÿÿÿÿÿüñòÍã¨ßƒÛ\ÁB—'GU Œ3§;:ÿ¼FJÿÙÿüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿçÿÏó³Ù˜Àq“G?!•š`:üÿÿ9ÿÿÿ6ÿÿÿ6îñÿ<º½ÿ\†‰ÿ‹TXÿ¸#'ÿìÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿóüèÕǾ–—f-.00,ÎÒ™9ÿÿÿ,ÿÿÿ ÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿÔÙÿ7ž¢ÿlhlÿ¢,1ÿÚÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿøÿÙíô—x?@ 8ãçÐBÿÿÿ6ÿÿÿ)ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿéîÿ$±¶ÿ[x}ÿ‘=Aÿ¾ÿøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿõÿáüÎŦ—X_vug ++EûÿèLÿÿÿ?ÿÿÿ5ÿÿÿ,ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿôøÿÄÈÿN‘”ÿwdhÿ¡8;ÿÎ!$ÿñÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÆâ–j` bb25LÿÿüUÿÿÿGÿÿÿ>ÿÿÿ6ÿÿÿ/ÿÿÿ*ÿÿÿ&ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿÿØÛÿ:·¹ÿY—šÿ|rtÿVXÿº;=ÿÑ!ÿïÿÿÿÿÿÿÿâ÷¡v;$tt5¢§+Uÿÿÿ\ÿÿÿNÿÿÿEÿÿÿ?ÿÿÿ9ÿÿÿ6ÿÿÿ2ÿÿÿ.ÿÿÿ+ÿÿÿ*ÿÿÿ(ÿÿÿ$ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷ùÿ)ÜÞÿLª¬ÿ=>ÿÿÿÿÿÿÿÑÙ I/EÀÄT]ÿÿÿ`ÿÿÿUÿÿÿMÿÿÿGÿÿÿCÿÿÿAÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ7ÿÿÿ5ÿÿÿ4ÿÿÿ0ÿÿÿ-ÿÿÿ+ÿÿÿ)ÿÿÿ&ÿÿÿ%ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿÿÿÿ ÿÿÿ#ÛÜÿ()ÿÿÿÿÿøÿHFPÔ؈gÿÿÿdÿÿÿ\ÿÿÿWÿÿÿRÿÿÿMÿÿÿLÿÿÿIÿÿÿFÿÿÿEÿÿÿBÿÿÿAÿÿÿ?ÿÿÿ<ÿÿÿ;ÿÿÿ8ÿÿÿ6ÿÿÿ4ÿÿÿ1ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ'ÿÿÿ%ÿÿÿ$ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿ:uuÿÿÿÿÿÿÿ;*%%]êïÀlÿÿÿhÿÿÿgÿÿÿaÿÿÿ^ÿÿÿZÿÿÿXÿÿÿUÿÿÿSÿÿÿPÿÿÿNÿÿÿKÿÿÿIÿÿÿHÿÿÿEÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ8ÿÿÿ5ÿÿÿ1ÿÿÿ/ÿÿÿ-ÿÿÿ)ÿÿÿ%ÿÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿš›ÿÿÿÿÿæò$[["5³ˆä;ìžÿIÿÈÿPÿáÿSÿðÿXÿÿÿ[ÿÿÿ`ÿÿÿdÿÿÿcÿÿÿ`ÿÿÿ\ÿÿÿYÿÿÿVÿÿÿSÿÿÿQÿÿÿNÿÿÿLÿÿÿJÿÿÿGÿÿÿFÿÿÿDÿÿÿBÿÿÿ?ÿÿÿ;ÿÿÿ8ÿÿÿ2ÿÿÿ0ÿÿÿ-ÿÿÿ(ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ  ÿÿÿÿÿ¾¯-oo`Úÿîÿãÿæÿå*ÿçGÿ"ëgÿ/îˆÿ8ñ¥ÿCóÆÿN÷äÿXùÿÿaÿÿÿhÿÿÿeÿÿÿaÿÿÿ_ÿÿÿ[ÿÿÿXÿÿÿTÿÿÿQÿÿÿMÿÿÿJÿÿÿFÿÿÿAÿÿÿ=ÿÿÿ8ÿÿÿ2ÿÿÿ/ÿÿÿ-ÿÿÿ(ÿÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿJ}}ÿÿÿÿÿ{B„€)ÀúÑÿâÿÿÿÿÿÿÿöÿòÿòÿð ÿ óÿè1ÿ×Fÿ&Úpÿ7ÞŸÿEâÊÿSåóÿaÿÿÿkÿÿÿfÿÿÿ`ÿÿÿYÿÿÿQÿÿÿJÿÿÿBÿÿÿ=ÿÿÿ8ÿÿÿ2ÿÿÿ0ÿÿÿ.ÿÿÿ*ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿž--ÿÿÿ¸ß‰ÿA|£~GEuw®°á¿ÿÚÿÿÿÿÿÿÿÿÿÿÿýÿüÿýÿãÿÃÿÉJÿ(Ï}ÿ9ÕµÿDãÞÿKÿÿÿJÿÿÿ>ÿÿÿ:ÿÿÿ4ÿÿÿ1ÿÿÿ1ÿÿÿ/ÿÿÿ,ÿÿÿ$ÿÿÿÿÿÿÿÿÿ ÿÿÿ@¼¼ÿÿÿÿÿ4)(U_„• ËµÿÚÿþÿÿÿÿÿÿÿÿÿÿÿÿÿ^—ÿÿÿËÿ\rÂÿQãÞÿ5ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ*ÿÿÿ"ÿÿÿÿÿÿÿÿÿ ÿÿÿ»,,ÿÿÿ’¦?E|yŸµ´âÜ÷ÿþ:´ÿÿÿÿÿüÜÿÿÿÿüÿrÐÑÿ0ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ-ÿÿÿ'ÿÿÿÿÿÿÿÿÿÿÿÿrxxÿÿÿÔÿ C1’Z)¶ŽäËÛäÿÿÿÿÉ£ÿÿ™Æÿ2ÿÿÿ4ÿÿÿ2ÿÿÿ/ÿÿÿ*ÿÿÿ!ÿÿÿÿÿÿ ÿÿÿ<´´ÿÿÿÿÿ'(x^ÃÒ ÿÿÑÿ0ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ,ÿÿÿ#ÿÿÿÿÿÿÿÿÿääÿý ÿÿÿ@KNÿÿÿÿ ÙÚÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ,ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿxlêÖÿÿøäÿÿ0ØÝÿ0ÿÿÿ1ÿÿÿ0ÿÿÿ,ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿïÿÿÿŽu„hmcÿÿÿÿÿÿÿÿÚÚÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ,ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿîÿÿÿƒt &}a×éÿÿÿÿ£´¶ÿ)ÿÿÿ1ÿÿÿ1ÿÿÿ0ÿÿÿ*ÿÿÿ#ÿÿÿÿÿÿÿÿÿííÿûÿÿÿ8J~<›q£Š¡ˆ ‡ †Ÿ…Ÿ…Ÿ„žƒžƒžƒž‚ž‚ž‚ž‚žžžžŸ‚Ÿ‚ž‚ǵ´‚͸ºƒ‘{³”ÝþÿÿZHòÿ/ÜÞÿ1ÿÿÿ3ÿÿÿ1ÿÿÿ/ÿÿÿ(ÿÿÿ!ÿÿÿÿÿÿ ÿÿÿ3ÀÁÿÿÿÿÿ‘“ÉßÖÿùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúÿÿ)ÿÿÜÿ©âÿ1ÿÿÿ2ÿÿÿ4ÿÿÿ3ÿÿÿ.ÿÿÿ&ÿÿÿÿÿÿÿÿÿÿÿÿe‡ˆÿÿÿäÿTŽÒÿøÿÿÿøÿ¸ÿÃ)ÿ ÏRÿÒUÿÑTÿÐTÿÐTÿÏSÿÏSÿÏSÿÏRÿÏRÿÏRÿÏRÿÏRÿÏRÿÏRÿÏRÿÏRÿÐRÿÐRÿÑIÿ›ààÿœáãÿ†ÏÛÿ5µæÿ'ðÿÿ4ÿÿÿ2ÿÿÿ4ÿÿÿ4ÿÿÿ1ÿÿÿ,ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿª>?ÿÿÿ£Ä†ëÿÿÿÿÛÿ¬-ÿGξÿgÿÿÿeÿÿÿdÿÿÿbÿÿÿaÿÿÿaÿÿÿ`ÿÿÿ`ÿÿÿ`ÿÿÿ`ÿÿÿ_ÿÿÿ_ÿÿÿ_ÿÿÿ_ÿÿÿ`ÿÿÿ_ÿÿÿ]ÿÿÿYÿÿÿWÿÿÿPÿÿÿJÿÿÿBÿÿÿAÿÿÿ=ÿÿÿ:ÿÿÿ4ÿÿÿ4ÿÿÿ2ÿÿÿ5ÿÿÿ5ÿÿÿ3ÿÿÿ.ÿÿÿ'ÿÿÿÿÿÿÿÿÿ ÿÿÿ2ÔÔÿøÿÿÿFC¦ÿÿÿûÿ¶ÿOÚÔÿlÿÿÿfÿÿÿ_ÿÿÿ\ÿÿÿYÿÿÿXÿÿÿXÿÿÿXÿÿÿWÿÿÿWÿÿÿWÿÿÿWÿÿÿVÿÿÿVÿÿÿVÿÿÿVÿÿÿVÿÿÿTÿÿÿSÿÿÿRÿÿÿNÿÿÿJÿÿÿDÿÿÿ?ÿÿÿ:ÿÿÿ:ÿÿÿ5ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ4ÿÿÿ1ÿÿÿ.ÿÿÿ'ÿÿÿ ÿÿÿÿÿÿÿÿÿ ÿÿÿ~SSÿÿÿÉÿ‡·ÿÿÿçÿ%¶aÿfÿÿÿiÿÿÿ^ÿÿÿYÿÿÿTÿÿÿQÿÿÿLÿÿÿLÿÿÿAßßÿ*““ÿHÿÿÿGÿÿÿGÿÿÿGÿÿÿGÿÿÿGÿÿÿ7ÈÈÿ!{{ÿ!{{ÿ"{{ÿ!{{ÿ7ÌÌÿBÿÿÿAÿÿÿ5ßßÿ!““ÿ8ÿÿÿ4ÿÿÿ2ÿÿÿ1ÿÿÿ1ÿÿÿ1ÿÿÿ0ÿÿÿ-ÿÿÿ'ÿÿÿ!ÿÿÿÿÿÿÿÿÿ ÿÿÿ5¶·ÿÿÿÿÿƒbB £âÿÿÚÿ7Å‘ÿmÿÿÿcÿÿÿYÿÿÿSÿÿÿMÿÿÿIÿÿÿEÿÿÿCÿÿÿBÿÿÿ7ßßÿGGÿ{{ÿ{{ÿ{{ÿ5ééÿ;ÿÿÿ;ÿÿÿ;ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ8ÿÿÿ8ÿÿÿ.ßßÿ““ÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ(ÿÿÿ%ÿÿÿ ÿÿÿÿÿÿÿÿÿ ÿÿÿÝÞÿÖÿÿÿÍÖ2…‘úÿÜÿ:È—ÿmÿÿÿ`ÿÿÿWÿÿÿOÿÿÿIÿÿÿEÿÿÿBÿÿÿ@ÿÿÿ=ÿÿÿ:ÿÿÿ/ßßÿxxÿ(ÏÏÿ&ÏÏÿ&ÏÏÿ,÷÷ÿ.ÿÿÿ.ÿÿÿ$ÈÈÿ{{ÿ{{ÿ{{ÿ{{ÿ$ÌÌÿ-ÿÿÿ+ÿÿÿ#ßßÿ GGÿ{{ÿ{{ÿ””ÿ%ÿÿÿ$ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÓÔÿÈ ÿÿÿúÿV7`#Æÿÿÿ'µbÿhÿÿÿ`ÿÿÿVÿÿÿNÿÿÿGÿÿÿDÿÿÿ@ÿÿÿ?ÿÿÿ:ÿÿÿ4ÿÿÿ1ÿÿÿ%ßßÿccÿ««ÿ««ÿ««ÿññÿ!ÿÿÿ"ÿÿÿÚÚÿ§§ÿ§§ÿ§§ÿ§§ÿÝÝÿ ÿÿÿ ÿÿÿßßÿ““ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ©ªÿçÿÿÿÿÿ]g}«ÿÿ¸ÿ_ÿÿÿcÿÿÿWÿÿÿNÿÿÿGÿÿÿBÿÿÿ?ÿÿÿ?ÿÿÿ9ÿÿÿ2ÿÿÿ/ÿÿÿ*ÿÿÿ#ððÿËËÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿííÿÓÓÿÓÓÿÓÓÿÓÓÿîîÿÿÿÿÿÿÿííÿÁÁÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿ^TUÿÿÿÿÿÿÿGy*f½ÿïÿ;Ýšÿgÿÿÿ[ÿÿÿQÿÿÿGÿÿÿCÿÿÿ?ÿÿÿ>ÿÿÿ9ÿÿÿ3ÿÿÿ1ÿÿÿ,ÿÿÿ&ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿÿÿÿüþÿEoqÿßÿÿÿÿÿíÿ"NIAeÿÿÕ ÿVüìÿcÿÿÿVÿÿÿJÿÿÿCÿÿÿ?ÿÿÿ=ÿÿÿ:ÿÿÿ4ÿÿÿ3ÿÿÿ+ÿÿÿ!Ìûÿ[ÍÞÿuÞãÿsÝâÿp‚‡ÿoosÿnpuÿlptÿlptÿlptÿkptÿkqtÿkquÿkquÿkquÿkruÿkrvÿksvÿktvÿktvÿktwÿjuwÿjuxÿhwyÿVXÿ¸ÿÿÿÿÿÿÿÿÿ¹Í;ŽÖÿÿ ÛRÿeÿÿÿ\ÿÿÿQÿÿÿFÿÿÿAÿÿÿ=ÿÿÿ7ÿÿÿ3ÿÿÿ3ÿÿÿäþÿ3ÖÿøÿÿÜÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüÿÞºcR±ÿõÿ3á‰ÿkÿÿÿXÿÿÿMÿÿÿCÿÿÿ?ÿÿÿ:ÿÿÿ3ÿÿÿ3ÿÿÿ&ÿÿÿP_ÒÿÿÿýÿgÀÁÞÄÈ ÝÀŠݠݠܟܟܟܟܟܟܟ۠۠۠ۡۡۡܢܣܣܤܥݦÅÁ[t$gÙÿóÿCè·ÿgÿÿÿVÿÿÿJÿÿÿBÿÿÿ>ÿÿÿ7ÿÿÿ3ÿÿÿ0ÿÿÿ_¶»ÿÿÿÿÿ|ùÿe^,¦"ÿÿòÿMêÒÿdÿÿÿTÿÿÿIÿÿÿBÿÿÿ=ÿÿÿ6ÿÿÿ2ÿÿÿ)ÿÿÿÑÁÆÿÿÿÿÿ䪨#ÿÿôÿQðÞÿdÿÿÿTÿÿÿHÿÿÿBÿÿÿ=ÿÿÿ6ÿÿÿ3ÿÿÿ ÿÿÿûàÿÿÿûÿÿ‰o„aÿÿóÿNìÕÿdÿÿÿTÿÿÿJÿÿÿBÿÿÿ=ÿÿÿ6ÿÿÿ3ÿÿÿ2ÿÿÿéÿÿÿ–€ÖÿóÿCæ³ÿfÿÿÿVÿÿÿJÿÿÿCÿÿÿ>ÿÿÿ9ÿÿÿ3ÿÿÿ6ÿÿÿ´ÿÿÿM/ØèQ8±ÿòÿ2݆ÿjÿÿÿXÿÿÿNÿÿÿEÿÿÿ?ÿÿÿ;ÿÿÿ3ÿÿÿ3ÿÿÿ#Éäÿ‚YñÿÿÿÿÿÿâÛèA#¢xGÓÿÿ!ÞTÿeÿÿÿ]ÿÿÿQÿÿÿGÿÿÿBÿÿÿ=ÿÿÿ7ÿÿÿ3ÿÿÿ1ÿÿÿZÒÛÿÿõôÿÿÿÿÿ7ÿÿÿÿ ÿÿÿûöîÓË»˜e)2fÿÿÓ ÿU÷èÿcÿÿÿWÿÿÿKÿÿÿCÿÿÿ?ÿÿÿ:ÿÿÿ3ÿÿÿ3ÿÿÿ0ÿÿÿEÞÜÿ»ÿáÿÿÿ8çÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿôÿÙìÁ±“uA?f»ÿêÿ;à˜ÿfÿÿÿ[ÿÿÿPÿÿÿGÿÿÿ@ÿÿÿ>ÿÿÿ8ÿÿÿ3ÿÿÿ3ÿÿÿ1ÿÿÿ-ÿÿÿ.ÿÿÿ%ñâÿ#ËÕÿP–›ÿZ_ÿª',ÿØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷ÿåþÑIJ‘zY{(ǧ€3 …¥ÿÿ¾ ÿ\ÿýÿcÿÿÿXÿÿÿNÿÿÿDÿÿÿ@ÿÿÿ>ÿÿÿ9ÿÿÿ5ÿÿÿ4ÿÿÿ2ÿÿÿ1ÿÿÿ.ÿÿÿ*ÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿ×Ûÿ<¬±ÿcƒˆÿ‹UZÿ´6;ÿß"'ÿïÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùÿæë·AÿJ#Çÿþÿ!±Tÿmÿÿÿ`ÿÿÿUÿÿÿLÿÿÿFÿÿÿAÿÿÿ?ÿÿÿ<ÿÿÿ:ÿÿÿ6ÿÿÿ3ÿÿÿ/ÿÿÿ,ÿÿÿ(ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿíòÿ2ÎÒÿL²¶ÿh’–ÿ†rvÿ¥PTÿÂ26ÿßÿÿÿÿÿÿÿÿÿÃ3"pp…ñÿìÿ/ª|ÿqÿÿÿ_ÿÿÿWÿÿÿMÿÿÿGÿÿÿDÿÿÿAÿÿÿ>ÿÿÿ=ÿÿÿ;ÿÿÿ8ÿÿÿ3ÿÿÿ.ÿÿÿ*ÿÿÿ&ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿ)õùÿ=äèÿVÒÖÿh®²ÿ…‚†ÿxbeöEH&ttªßÿÿêÿ0¡‚ÿqÿÿÿaÿÿÿYÿÿÿQÿÿÿMÿÿÿHÿÿÿEÿÿÿBÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ9ÿÿÿ5ÿÿÿ1ÿÿÿ.ÿÿÿ+ÿÿÿ)ÿÿÿ&ÿÿÿ$ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ"ÿÿÿ-ÿÿÿ:ÿÿÿLÿÿÿI÷úØNNÄÿÿÿôÿ&£cÿgÿÿÿeÿÿÿ]ÿÿÿWÿÿÿSÿÿÿOÿÿÿLÿÿÿIÿÿÿGÿÿÿDÿÿÿAÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ9ÿÿÿ7ÿÿÿ4ÿÿÿ1ÿÿÿ/ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ)ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ!ÿÿÿ"ÿÿÿ$ÿÿÿ)ÿÿÿ2ÿÿÿ=ÿÿÿIÿÿÿVÿÿÿIàä¡&+¼ÿÿÿøÿ ¬!ÿQðÙÿcÿÿÿfÿÿÿaÿÿÿ\ÿÿÿXÿÿÿUÿÿÿRÿÿÿOÿÿÿNÿÿÿKÿÿÿJÿÿÿGÿÿÿEÿÿÿCÿÿÿBÿÿÿ@ÿÿÿ?ÿÿÿ=ÿÿÿ:ÿÿÿ9ÿÿÿ6ÿÿÿ4ÿÿÿ1ÿÿÿ0ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ.ÿÿÿ2ÿÿÿ6ÿÿÿ?ÿÿÿIÿÿÿVÿÿÿZÿÿÿGÌÐlÿÿ1 ¡ÏéÿÿÿÍÿÂEÿAë±ÿRüåÿYÿÿÿ`ÿÿÿeÿÿÿdÿÿÿbÿÿÿ_ÿÿÿ[ÿÿÿXÿÿÿUÿÿÿSÿÿÿPÿÿÿOÿÿÿLÿÿÿKÿÿÿHÿÿÿGÿÿÿDÿÿÿCÿÿÿ@ÿÿÿ?ÿÿÿ>ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ;ÿÿÿ>ÿÿÿBÿÿÿIÿÿÿRÿÿÿ`ÿÿÿ_ÿÿÿ?®²E7ŒŒ!vr´öøÿÿÿÝÿØÿà.ÿèLÿ%ågÿ.åƒÿ;é©ÿFìÍÿRïîÿ]ýÿÿiÿÿÿiÿÿÿeÿÿÿbÿÿÿ^ÿÿÿZÿÿÿVÿÿÿTÿÿÿRÿÿÿPÿÿÿNÿÿÿLÿÿÿKÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿDÿÿÿGÿÿÿMÿÿÿSÿÿÿ[ÿÿÿhÿÿÿbÿÿÿ+pt*5<op¡ëÓÿÿÿÿÿÿÿúÿñÿïÿðÿó ÿ ìÿ Ó*ÿÐSÿ,Ô€ÿ=Ù®ÿMÞßÿ]ôÿÿlÿÿÿjÿÿÿgÿÿÿdÿÿÿ`ÿÿÿ\ÿÿÿXÿÿÿWÿÿÿUÿÿÿRÿÿÿQÿÿÿPÿÿÿOÿÿÿPÿÿÿRÿÿÿVÿÿÿ]ÿÿÿeÿÿÿpÿÿÿgÿÿÿ ??Rz:Eu’µ­ä¸ÿØÿÿÿÿÿÿÿÿÿÿÿýÿüÿýÿÿÿïÿÃÿÃ.ÿ È^ÿ4ϘÿGÓÎÿ\øÿÿlÿÿÿiÿÿÿgÿÿÿcÿÿÿaÿÿÿ]ÿÿÿ\ÿÿÿ\ÿÿÿ\ÿÿÿ]ÿÿÿbÿÿÿgÿÿÿoÿÿÿxÿÿÿlúþä++)V_…– Îµÿáÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿ¿ÿÀÿÇOÿ.Ì„ÿBÕ¾ÿUú÷ÿdÿÿÿeÿÿÿdÿÿÿgÿÿÿhÿÿÿmÿÿÿtÿÿÿ{ÿÿÿ€ÿÿÿeàåµJH‚} ¯µÞáîóùôÿôÿ÷ÿþÿÿÿÿÿÿÿÿÿíÿÉÿË ÿÑ<ÿ(×oÿ;ߤÿRÿÙÿbÿûÿnÿÿÿyÿÿÿzÿÿÿY®¹| M3„Z¤…º¨Ò¿ßØâðæÿëÿøÿÿÿÿÿÿÿÿÿóÿÜÿÝÿáHÿ-ê|ÿ)Ëwÿ„6Lm-WŒ5¨N´oµ“¸ÌáÕÿÝÿñÿÿÿÿÿÿ*ÿÿAÿïKÿz&!?j–µ›<xo ¢¶!ÏÅ2ÿÐCÿ¿Gÿ) Kx “/ÂH9ÿÿÿÿÿÿÿÿüÿÿÿÿÿÿþ?ÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿ€ÿÿÿÿÀÿÿÿàÿÿÿð?ÿÿøÿÿüÿÿüÿÿþÿÿÿÿÿÿ€ÿÿÿÀÿÿþÿÿÿø?ÿÿÿÿð?ÿÿÿÿÿÀ?ÿÿÿÿÿð?ÿÿÿÿÿø?ÿÿÿÿÿø?ÿÿÿÿÿø?ÿÿÿÿÿð?ÿÿà?ÿþ?ÿø?ÿðÿàÿÀÿÿ€ÿÿÿÿÿþÿþÿþÿüÿüÿÿüÿÿÿÿÿüÿÿÿÿÿüÿÿÿÿÿüÿÿÿÿÿüÿÿÿÿÿüÿÿÿÿÿüÿÿÿÿþ?ÿÿÿþÿÿþÿÿÿÿÿÿÿÿÿ€ÿÿÀ?ÿÿà?ÿÿðÿÿüÿÿÿÿÿÿàÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿüÿÿÿÿÿÿüÿÿÿÿÿÿø?ÿÿÿÿÿÿÿÿ(€ LS Qn0B(7sö²ÿ¤ì˜ÒŒ ¶ƒ“yz`^7L7!eDÅñÿÿÿÿÿÿè ÿ×ÿÈÿÅðÁݱɺ„ª_.mP'U d aÌýÿÿÿþÿÿÿþÿÿÿÿÿÿüÿóÿëÿåÿäõæí¿â­ÝoÎ]³)ˆh8#\ ]çÿÿ ÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿýÿüÿúÿúþúüýûÎù¸øvôfÔ*˜~:$  µç ÿñþôÿøÿüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿÿÿÿÿÛÿ²ÿ‚ÿpÞI­$”-R@-}S 22Ö;stÿ\GGþ{55ÿ˜++ÿ¹ÿÍÿÒ ÿàÿìÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿÿÿÿÿáÿ²ÿ˜ÿŒêrÂ`ŸdrjSf8B/  ;;=%½½ì1ÿÿÿ!üüþääÿËËÿ§§ÿ$™™ÿAxxÿYaaÿtIIÿˆ88ÿªÿ¶ÿÐÿãÿüÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿÿÿÿÿéÿÅÿ±ÿªîœÌ‘°ˆ™{‚]f+N8#LL 22J)¸¸÷7ÿÿÿ0ÿÿþ'ÿÿÿ ÿÿÿÿÿÿÿÿÿ ýýÿêêÿÝÝÿÃÃÿººÿ0££ÿ<ˆˆÿLeeÿTPPÿ„ÿ“ ÿºÿãÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿúÿéÿÚÿÎÿËîÈ޶ΟÀz­_–kQ)³ÿÿUUe3ááÿ7ÿÿÿ/þþÿ)ÿÿÿ#þþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ûûÿóóÿïïÿääÿààÿÒÒÿ ±±ÿ&yyÿ3ZZÿ`++ÿ ÿ§ÿÌÿþÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿüÿõÿìÿêþéõëïÁæ­âpÖ\¸*Œk:tt„6ããÿ7ÿÿþ1þþÿ,ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ þþÿ þþÿ ýýÿ ýýÿ üüÿ üüÿ ïïÿ ÅÅÿ‘‘ÿqqÿE==ÿvÿ‘ÿ¹ÿõÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿþÿþÿýÿýþýýÿýÎü¨üvó`Í,›<&’’«;ïïÿ:ÿÿÿ4ÿÿÿ0ÿÿÿ*ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ þþÿ ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿØØÿ¦¦ÿyyÿ4VVÿb$$ÿ‚ÿ±ÿÙ ÿêÿìÿñÿöÿýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿÿÿÿÿÛÿ¤ÿƒþpØA£,–9UL2l( ++,0±±ÒBþþÿ=þþþ9ÿÿÿ4ÿÿÿ/ÿÿÿ+ÿÿÿ&ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿØØÿ¸¸ÿŠŠÿ'xxÿONNÿq<<ÿ–--ÿ³""ÿÆÿÍ ÿáÿêÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿÿÿÿÿáÿµÿ•ÿwò_»W9?#LL ''>7ÁÁäGÿÿÿ@þþþ<ÿÿÿ7ÿÿÿ3ÿÿÿ/ÿÿÿ+ÿÿÿ'ÿÿÿ$ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿüüÿààÿËËÿ¬¬ÿŸŸÿCyyÿRjjÿsIIÿ::ÿ¥ÿ±ÿÍÿáÿýÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿýÿÒÿ£ÿ‚ÍV”V }ÿÿ44P=ÈÈÿKÿÿþCþþÿ>ÿÿÿ:ÿÿÿ7ÿÿÿ3ÿÿÿ/ÿÿÿ+ÿÿÿ)ÿÿÿ&ÿÿÿ$ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿýýÿèèÿßßÿÉÉÿÁÁÿ.¬¬ÿ8ÿGiiÿMTTÿÿšÿºÿæÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿþÿÿÿÿþÿÿúÿÕÿºòcÉo==]FááÿLÿÿþFþþÿBÿÿÿ=ÿÿÿ:ÿÿÿ7ÿÿÿ3ÿÿÿ0ÿÿÿ-ÿÿÿ+ÿÿÿ(ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ üüÿ õõÿ òòÿééÿääÿÔÔÿ­­ÿ!||ÿ-^^ÿ]--ÿ‹ÿ©ÿæÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿðÿÏöJÝU ccLîîÿOÿÿÿIÿÿþDÿÿÿ@ÿÿÿ=ÿÿÿ:ÿÿÿ7ÿÿÿ4ÿÿÿ2ÿÿÿ.ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ(ÿÿÿ(ÿÿÿ&ÿÿÿ%ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ ììÿ ··ÿŽŽÿttÿD??ÿt ÿ‰ÿ¸ÿôÿþÿþÿþÿÿÿÿÿþÿÿÿüÿ›ÿ¶.‡‡·RööÿQÿÿÿLþþþGÿÿÿCÿÿÿ@ÿÿÿ=ÿÿÿ;ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ.ÿÿÿ-ÿÿÿ+ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ'ÿÿÿ'ÿÿÿ&ÿÿÿ%ÿÿÿ%ÿÿÿ$ÿÿÿ"ÿÿÿ!ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿûûÿ»»ÿ||ÿ755ÿ‹ÿÛÿöÿÿÿÿÿÿÿÿþÿþëÿXòJLL$$!=®®ËVûûÿRÿÿÿNÿÿÿJÿÿÿFÿÿÿCÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ:ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ.ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ(ÿÿÿ'ÿÿÿ&ÿÿÿ&ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ!ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ÿÿÿÑÑÿ {{ÿ[55ÿ¯ ÿðÿÿÿÿÿþÿÿþýÿÿ2†–ÿÿ..;EÀÀåYÿÿÿTþþÿPÿÿÿMÿÿÿIÿÿÿEÿÿÿCÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ5ÿÿÿ5ÿÿÿ4ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ.ÿÿÿ-ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ(ÿÿÿ'ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ"ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿëëÿ ££ÿIMMÿÁÿÿÿÿÿþÿÿþÿÿ´ÿ7«'**ZQÚÚÿ\ÿÿþVþþÿSÿÿÿOÿÿÿKÿÿÿIÿÿÿFÿÿÿDÿÿÿBÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ7ÿÿÿ7ÿÿÿ6ÿÿÿ6ÿÿÿ4ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ.ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ'ÿÿÿ&ÿÿÿ%ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ"ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ ììÿ¨¨ÿRÿáÿÿÿþÿÿÿÿþÎÿXÈ,33uXééÿ]ÿÿþXþþÿUÿÿÿRÿÿÿNÿÿÿMÿÿÿIÿÿÿHÿÿÿEÿÿÿDÿÿÿCÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ>ÿÿÿ>ÿÿÿ=ÿÿÿ=ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ7ÿÿÿ5ÿÿÿ4ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ'ÿÿÿ&ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ$ÿÿÿ"ÿÿÿ!ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿþþÿææÿYYÿÁÿÿÿÿÿþÿÿÿÝÿNÌ#%% RR¢^ööÿ^ÿÿÿ[þþþWÿÿÿTÿÿÿQÿÿÿOÿÿÿMÿÿÿLÿÿÿJÿÿÿIÿÿÿHÿÿÿFÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿCÿÿÿAÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ5ÿÿÿ4ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ(ÿÿÿ'ÿÿÿ'ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÿŽŽÿ„ ÿúÿÿÿþÿÿþßÿBªLL/wwÉaúúÿ`ÿÿÿ\þþþZÿÿÿWÿÿÿUÿÿÿSÿÿÿQÿÿÿPÿÿÿNÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿJÿÿÿIÿÿÿGÿÿÿGÿÿÿFÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿBÿÿÿAÿÿÿAÿÿÿ@ÿÿÿ>ÿÿÿ?ÿÿÿ>ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ(ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ"ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿ––ÿqÿôÿÿÿþÿÿþÆÿ%— ?žžÒcüüÿeÿÿþbÿÿÿ^ÿÿÿ[ÿÿÿXþþÿWÿÿÿUÿÿÿSÿÿÿSÿÿÿQÿÿÿQÿÿÿPÿÿÿOÿÿÿNÿÿÿMÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿHÿÿÿHÿÿÿGÿÿÿFÿÿÿFÿÿÿDÿÿÿDÿÿÿCÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ9ÿÿÿ7ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ3ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ+ÿÿÿ*ÿÿÿ*ÿÿÿ(ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ"ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿþþÿÿÿÿººÿ]ÿöÿÿÿþÿÿþ–ÿj?C>5‘„ä>«œÿJ®½þUÓßÿ[çòÿfÿÿÿbÿÿÿ_ÿÿÿ]ÿÿÿZÿÿÿXÿÿÿVþþÿVÿÿÿTÿÿÿTÿÿÿSÿÿÿRÿÿÿQÿÿÿPÿÿÿOÿÿÿOÿÿÿNÿÿÿNÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿIÿÿÿHÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿDÿÿÿCÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ0ÿÿÿ0ÿÿÿ.ÿÿÿ,ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ'ÿÿÿ&ÿÿÿ$ÿÿÿ"ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ ØØÿdÿÿÿÿÿþþÿÿvó> [± ô Ìÿ±&ÿ¢-ÿˆ>ÿ$Ž`ÿ1’…ÿ=”¤ÿLÄÑÿVßëÿdÿÿÿ`ÿÿÿ_ÿÿÿ]ÿÿÿZÿÿÿXÿÿÿVþþÿVÿÿÿUÿÿÿTÿÿÿSÿÿÿSÿÿÿRÿÿÿQÿÿÿPÿÿÿPÿÿÿOÿÿÿNÿÿÿNÿÿÿLÿÿÿKÿÿÿKÿÿÿJÿÿÿJÿÿÿIÿÿÿGÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿDÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ&ÿÿÿ$ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ±±ÿ£ÿÿÿþÿÿþøÿ8Ï@…×ýâþàÿÜÿÝÿÝÿÞÿ´ ÿœ ÿ uÿ|Dÿ'€hÿ3ƒÿGºÂÿVåêÿaÿÿÿ^ÿÿÿ]ÿÿÿ\ÿÿÿZÿÿÿXÿÿÿWþþÿVÿÿÿVÿÿÿUÿÿÿTÿÿÿTÿÿÿRÿÿÿRÿÿÿQÿÿÿPÿÿÿPÿÿÿOÿÿÿNÿÿÿMÿÿÿLÿÿÿLÿÿÿKÿÿÿKÿÿÿIÿÿÿGÿÿÿFÿÿÿFÿÿÿDÿÿÿCÿÿÿBÿÿÿ?ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ6ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ'ÿÿÿ&ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúÿŽŽÿÆÿÿÿþÿÿþÏøvE`»åÿå ÿäþåÿåÿäÿæÿçÿèÿèÿèÿèÿÇÿÿrÿy,ÿ$}aÿ,wÿFľÿSæáÿZúöÿYùöÿYùùÿYúúÿYüýÿYþþÿYÿÿÿWÿÿÿVÿÿÿVÿÿÿUÿÿÿTÿÿÿSþþÿSÿÿÿRÿÿÿQÿÿÿQÿÿÿOÿÿÿNÿÿÿMÿÿÿMÿÿÿJÿÿÿHÿÿÿGÿÿÿFÿÿÿDÿÿÿBÿÿÿ?ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ:ÿÿÿ7ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ*ÿÿÿ(ÿÿÿ'ÿÿÿ$ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿêêÿ=KKÿéÿÿÿþÿóÿv×)ÿÿzÇÝÿèÿçÿç ÿçÿæÿåÿäÿåÿåÿåÿèÿêÿíÿìÿìÿëÿ®ÿÿÿ „ÿ!‰Yÿ(—mÿ:»ÿEÔ½ÿMâÔÿOâÙÿSãèÿVìðÿXõùÿ[ÿÿÿ[ÿÿÿYÿÿÿXÿÿÿWÿÿÿVÿÿÿUÿÿÿTþþÿSÿÿÿRÿÿÿOÿÿÿNÿÿÿLÿÿÿJÿÿÿHÿÿÿEÿÿÿCÿÿÿAÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ:ÿÿÿ7ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ*ÿÿÿ)ÿÿÿ'ÿÿÿ%ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÀÀÿƒÿüÿÿÿÿÿÉÿ|zÀ«جç±ú´ÿÊÿÜÿìÿê ÿêÿêÿçÿæÿäÿåÿåÿåÿéÿëÿíÿìÿìÿàÿ»ÿ¡ÿ–ÿ™ÿžAÿ"¨\ÿ,´xÿ7À•ÿ?ĬÿDżÿLÇÒÿQÙãÿXíõÿ^ÿÿÿ]ÿÿÿZÿÿÿYÿÿÿUÿÿÿSÿÿÿPþþÿNÿÿÿLÿÿÿIÿÿÿEÿÿÿCÿÿÿ@ÿÿÿ>ÿÿÿ;ÿÿÿ9ÿÿÿ9ÿÿÿ5ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ)ÿÿÿ'ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿppÿÑÿþÿÿþóÿzÕ$/@I Sccqˆv¤|ÀŠÚ•÷œ ÿÇÿ×ÿîÿì ÿí ÿìþèÿæÿäÿåÿäÿåÿèÿéÿêÿêÿêÿÚÿÈÿ³ÿ²ÿ´ÿ¶*ÿ±;ÿªMÿ%¢dÿ0¥ƒÿ:¨¡ÿBªºÿMÑÞÿSèóÿ\ÿÿÿWÿÿÿSÿÿÿOÿÿÿIÿÿÿFÿÿÿCÿÿÿ?þþÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ4ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ)ÿÿÿ'ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿééÿ\ÿÿÿþÿÿÿ®ÿ8_  L )f 1L nH„Q°i Ï þ”ÿ½ÿÓÿïÿìÿì ÿë ÿèÿæÿäÿåÿäÿåÿæÿçÿçÿçÿçÿßÿÖÿÌÿÌÿÍ ÿÎÿ ±!ÿ Ÿ'ÿ…>ÿ ‹_ÿ-Žÿ2¡ÿAÜÏÿAíåÿFÿÿÿDÿÿÿ?ÿÿÿ<ÿÿÿ:ÿÿÿ9þþÿ5ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ)ÿÿÿ'ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ~~ÿêÿÿÿÿþôÿP´ 6h 0Nh1¤O Áu ÿ†ÿ·ÿØÿéÿèÿèÿç ÿæÿåÿäÿåÿäÿåÿåÿåÿåÿåÿåÿäÿáÿßÿáÿÞÿúÿ»ÿ«ÿ nÿ:{ÿZgÿˆ†ÿ5ôôÿ:ÿÿÿ6þþÿ3þþÿ2ÿÿÿ1ÿÿÿ2ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ*ÿÿÿ)ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿóóÿeÿÿÿþÿÿÿ€ÿE<^I ¶k ëŒð°ó×öÝúÜüÝ ÿß ÿâÿåÿåÿåÿåÿåÿåÿäÿéÿ»/ÿÿÿÿÿÿÿÿÿÿÿ‚[ÿÿôäáÿwfaÿ+—“ÿ6÷÷ÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ2ÿÿÿ0ÿÿÿ0ÿÿÿ.ÿÿÿ-ÿÿÿ*ÿÿÿ(ÿÿÿ$ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿZZÿúÿÿÿÿþÃÿ%n -Q{C˜f ÄͦÙÇçÆ ñÇüÈÿÕÿàÿèÿíÿ³=ÿÿþÿÿÿÿþÿÿÿÏ»þÿÿÿÿÿÿÿÿÿÕÈÈÿD~ÿ0èèÿ2ÿÿÿ0þþÿ1ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ)ÿÿÿ'ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÛÿžÿÿÿÿÿÿÿ1Ä"E]Jxdƒª”¿£×¯è^QÿÄÿßÿøÿÿÿ ÿÿôñÿÿþþþÿÿÿÿÿÿÿÿÿëÞÝÿP‘ÿ0ðîÿ1ÿÿÿ1ÿÿÿ2ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ'ÿÿÿ$ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿMÿÿÿþÿÿÿrþ .+<4QpZx{Ÿ†À0(Š÷ÍÃÆÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿ®¦Äÿgiÿ3ÿÿÿ0þþÿ1ÿÿÿ2ÿÿÿ3ÿÿÿ2ÿÿÿ0ÿÿÿ0ÿÿÿ.ÿÿÿ+ÿÿÿ)ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ%bbÿüÿÿÿÿþ²ÿ9 %!:832q˜”’ÿÿÿÿÿÿÿÿþÒÍÿÿ41ÿÿÿ%Àºÿ1ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ,ÿÿÿ)ÿÿÿ&ÿÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ››ÿÎÿÿÿÿÿôÿs 9[ZXò¾¯øÿ ÿþÿÿÿÿ-Bÿ4ÿÿÿ0þþÿ1ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ(ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿßßÿ¢ÿÿÿÿÿÿÿ› D~üÿÿÿÿÿÿ™ÿ+ÞÓÿ1ÿÿÿ1ÿÿÿ1ÿÿÿ1ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ)ÿÿÿ$ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿççÿ~ÿÿÿÿÿÿÿU¿ ^Ÿâÿÿþÿÿçÿ‘ƒÿ2ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ)ÿÿÿ%ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿêêÿt%%ÿÿÿÿÿÿÿUÙF\¸ÿÿÿþÿúÿlÿ3ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ*ÿÿÿ)ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿïïÿNDDÿÿÿÿÿÿþwþ1B\\¸ñ€€ÿÿ~~ÿÿz|ùÿ'{‘ÿ1ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ+ÿÿÿ)ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿññÿSQQÿÿÿÿÿÿÿû)*+I¬­±úýýÿÿùùÿÿòóùÿ=‘ÿ.ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ*ÿÿÿ)ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿññÿSPPÿÿÿÿÿÿÿ~û_YYqÈÅÅÿÿÿÿÿþþþÿõøøÿssÿ3ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ)ÿÿÿ%ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿññÿSPPÿÿÿÿÿÿÿ~ûmigÃúøøÿÿÿÿÿÿÿÿÿ¹½½ÿ¬¬ÿ2ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ)ÿÿÿ%ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿììÿV33ÿÿÿÿÿÿÿjö -…”Œ«ÿÿÿÿÿÿÿþÿÿÿÿÿH\\ÿ,ûûÿ1ÿÿÿ0ÿÿÿ1ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ(ÿÿÿ%ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèèÿ‚ÿÿÿÿÿÿÿMÅ—¬ÿNBÿÿÞÔþþÿÿÿÿÛÕÔÿ††ÿ2ÿÿÿ0þþÿ1ÿÿÿ1ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ,ÿÿÿ)ÿÿÿ'ÿÿÿ$ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿççÿŽÿÿÿþÿÿÿ)­GSRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRM…tÎÚÿÿÿÿþ ÿÿ”‡ìÿ2X\ÿ/ùùÿ1ÿÿÿ0ÿÿÿ1ÿÿÿ1ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ)ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¹¹ÿ»ÿÿÿÿÿÿÿˆu* Ëyì¼#ñÙ&ó×#ò× ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò×ò× ò×ò×ò×ò×òÕòÓìÓòïïïòïïïòïïïòûûðòtpêúóÿÿÿþþÿÿÿÿ aÿ'ÒÒÿ1ÿÿÿ0þþÿ1ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ+ÿÿÿ(ÿÿÿ&ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ €€ÿïÿÿÿÿÿáÿTF¿oýÆ"ÿç$ÿæþåÿäÿåÿåÿåÿå ÿå ÿå ÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿãÿàûàÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿƹþÿ ÿÿÿÿÿÿöÿxÿ+ÚÚÿ3ÿÿÿ2þþÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ*ÿÿÿ'ÿÿÿ$ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ3;;ÿÿÿþÿÿÿŒÿ(I6 ÐŽÿã$ÿíÿçþäÿå ÿäÿåÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿæÿäÿâýâÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿõÿÿÿÿðÿÑÿ 0tÿ'Ľÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ3ÿÿÿ2ÿÿÿ/ÿÿÿ/ÿÿÿ,ÿÿÿ)ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿõõÿvÿÿÿÿÿÿÿRä FG Áˆÿå#ÿîþåÿä ÿäÿèÿêÿëÿÜÿÃÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ¸ÿ·ÿ½Ìµÿ×ÎÎÿ×ÎÎÿ×ÏÏÿÔËËÿÔ×Éÿ3-¹ÿ 9™ÿ{ÿ/éáÿ3ÿÿÿ2þþÿ2þþÿ2ÿÿÿ2ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ+ÿÿÿ(ÿÿÿ%ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ ŽŽÿáÿÿÿÿþéÿ—-4  ˆøÒ ÿíþåÿäÿåÿìÿðÿ¹ÿÿ “ÿ›Fÿ( hÿ4¸‹ÿ4¹‹ÿ4¹‹ÿ4¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ3¹‹ÿ2¹‹ÿ2¹‹ÿ1¹‹ÿ0¹‹ÿ/¹‹ÿ.¹‹ÿ-¹‹ÿ+¹‹ÿ*¹‹ÿ(¹‹ÿ&¹‹ÿ!¸ˆÿO½¸ÿT¾¾ÿS¾¾ÿQ¾¾ÿNººÿ<µ¶ÿ)¹­ÿ1çÞÿ6ÿÿÿ3ÿÿÿ2þþÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ3ÿÿÿ4ÿÿÿ4ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ)ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ7ÿÿÿÿÿÿÿœÿ18UZÝÃÿåÿæÿäÿåÿíÿçÿÿ eÿ.›yÿGͽÿPÕÖÿUáçÿZòöÿ`ÿÿÿ_ÿÿÿ^ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ]ÿÿÿ\ÿÿÿ[ÿÿÿZÿÿÿYÿÿÿWÿÿÿVÿÿÿTÿÿÿRÿÿÿOÿÿÿLÿÿÿHÿÿÿEÿÿÿCÿÿÿ<ÿÿÿ:ÿÿÿ7ÿÿÿ6ÿÿÿ7ÿÿÿ8ÿÿÿ5ÿÿÿ3ÿÿÿ2þþÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ4ÿÿÿ4ÿÿÿ5ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ)ÿÿÿ(ÿÿÿ$ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿµµÿ±ÿÿÿÿÿÿÿaÛ“€ûä!ÿåÿå þäÿæÿãÿ„ÿV5ÿF¾¶ÿYïïÿ[øùÿ\ÿÿÿZÿÿÿYÿÿÿWÿÿÿVÿÿÿVÿÿÿUÿÿÿUÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿTÿÿÿSÿÿÿSÿÿÿRÿÿÿQÿÿÿPÿÿÿOÿÿÿMÿÿÿJÿÿÿHÿÿÿFÿÿÿBÿÿÿ?ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ8ÿÿÿ8ÿÿÿ9ÿÿÿ4ÿÿÿ3ÿÿÿ2ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ3ÿÿÿ4ÿÿÿ5ÿÿÿ5ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ+ÿÿÿ(ÿÿÿ&ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ&77ÿûÿÿÿÿþÌÿN‚£—ÿì þäÿåÿåÿâÿ¾ÿJ+ÿF²¹ÿ`ÿÿÿ\ÿÿÿYÿÿÿXÿÿÿVÿÿÿTÿÿÿSÿÿÿRÿÿÿQÿÿÿOüüÿ ÿÿIîîÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿOÿÿÿNÿÿÿMÿÿÿLÿÿÿLÿÿÿJÿÿÿHÿÿÿGÿÿÿDÿÿÿAÿÿÿ@ÿÿÿ<üüÿ ÿÿ 22ÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ3ÿÿÿ2ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ3ÿÿÿ4ÿÿÿ4ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ,ÿÿÿ)ÿÿÿ&ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¬¬ÿ¨ ÿþÿÿþÿÿŽú:u´» ÿëþäÿåÿäÿÏÿ yÿ.l|ÿ_ýÿÿ^ÿÿÿYÿÿÿVþþÿTÿÿÿRÿÿÿQÿÿÿPÿÿÿNÿÿÿMÿÿÿMÿÿÿKÿÿÿ77ÿÿ6¼¼ÿJÿÿÿJÿÿÿJÿÿÿIÿÿÿJÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿ.££ÿ%ƒƒÿ%ƒƒÿ%ƒƒÿ%ƒƒÿ&ƒƒÿ%ƒƒÿ%ƒƒÿ%ƒƒÿ%ƒƒÿ$ƒƒÿ%„„ÿDûûÿEÿÿÿDÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ 77ÿÿÿ5ùùÿ5ÿÿÿ2ÿÿÿ2ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ+ÿÿÿ)ÿÿÿ'ÿÿÿ$ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿôôÿD44ÿõÿÿÿÿÿçÿV£ 0 §Ãÿçÿäÿæÿàÿ¡ÿmHÿNÈÐÿbÿÿÿZÿÿÿVþþÿTÿÿÿRÿÿÿPÿÿÿNÿÿÿLÿÿÿJÿÿÿIÿÿÿHÿÿÿHÿÿÿFÿÿÿjjÿÿ%‰‰ÿEÿÿÿEÿÿÿDÿÿÿDÿÿÿEÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿggÿÿÿÿÿÿÿÿÿÿÿÿ5ÐÐÿAÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ:ÿÿÿjjÿÿÿ*ÌÌÿ4ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ+ÿÿÿ)ÿÿÿ'ÿÿÿ#ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýÿ€€ÿ¼ÿÿÿþÿüÿ£ñNŒŸÿçÿåþåÿåÿ‡ÿ-…wÿZñõÿ]ÿÿÿWþþÿUÿÿÿRÿÿÿPÿÿÿMÿÿÿKÿÿÿJÿÿÿHÿÿÿFÿÿÿEÿÿÿCÿÿÿBÿÿÿAÿÿÿ(ÿÿÿÿÿÿÿÿÿÿÿ&ÿ?ÿÿÿ?ÿÿÿ?ÿÿÿ?ÿÿÿ?ÿÿÿ7ààÿ.»»ÿ.»»ÿ.»»ÿ.»»ÿ.»»ÿ.»»ÿ.»»ÿ.»»ÿ-»»ÿ-»»ÿ-»»ÿ8êêÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ!ÿÿÿ™™ÿ1ÿÿÿ1ÿÿÿ1ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ'ÿÿÿ#ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÀÀÿtÿüÿÿÿþÿêý-¨hŠÿäÿå þäÿìÿhÿ:¡šÿ\÷úÿ[ÿÿÿVÿÿÿSÿÿÿQÿÿÿMÿÿÿKÿÿÿIÿÿÿGÿÿÿEÿÿÿCÿÿÿBÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ=ÿÿÿ1ÐÐÿÿÿÿ??ÿ??ÿ??ÿ??ÿ??ÿ??ÿ??ÿ!““ÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ5ÿÿÿ3ÿÿÿ(ÐÐÿÿÿeeÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ/ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ'ÿÿÿ%ÿÿÿ#ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿññÿ611ÿöÿÿÿþÿÿþsò)(Vÿì ÿåþäÿîÿZÿBª­ÿ_ÿÿÿYÿÿÿUþþÿRÿÿÿNÿÿÿKÿÿÿJÿÿÿHÿÿÿEÿÿÿCÿÿÿAÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ<ÿÿÿ<ÿÿÿ9ûûÿÿÿ 77ÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ7ÿÿÿ7ÿÿÿ7ÿÿÿ7ÿÿÿ7ÿÿÿ5úúÿÿÿÿÿÿÿÿÿÿÿÿ 55ÿ4ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ1ÿÿÿ/ÿÿÿ.ûûÿÿÿÿÿÿÿÿÿÿÿ••ÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ%ÿÿÿ$ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿ,,ÿëÿÿÿþÿÿþÛÿ‚*çç"ÿåÿæÿéÿÿF²¶ÿ`ÿÿÿXþþÿUÿÿÿRÿÿÿOÿÿÿKÿÿÿJÿÿÿFÿÿÿCÿÿÿAÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ 66ÿÿÿÿÿÿÿÿÿÿÿ/úúÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿccÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ GGÿ/þþÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ-ÿÿÿ-ÿÿÿ-ÿÿÿ 66ÿÿÿ ;;ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿÿ'ÿÿÿ%ÿÿÿ$ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿþþÿÿÿÿÿÿÿ ZZÿÚÿÿÿþÿÿÿóÿ ÅŠÁ ÿèþåÿéÿµÿ,vvÿbÿÿÿZþþÿUÿÿÿRÿÿÿLÿÿÿJÿÿÿHÿÿÿEÿÿÿBÿÿÿ?ÿÿÿ>ÿÿÿ>ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿiiÿÿÿ//ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ ??ÿ%ÞÞÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ+ÿÿÿ*ÿÿÿ*ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ)ÿÿÿiiÿÿÿ ÎÎÿ(ÿÿÿ'ÿÿÿ'ÿÿÿ'ÿÿÿ&ÿÿÿ$ÿÿÿ$ÿÿÿ#ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿ îîÿ\\ÿÑÿÿÿþÿÿþòÿHã6oõéþä ÿêÿ»ÿpOÿ_ýþÿZþþÿUÿÿÿQÿÿÿNÿÿÿJÿÿÿGÿÿÿDÿÿÿ@ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ;ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿœœÿÿÿžžÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ(ÿÿÿ(ÿÿÿ'ÿÿÿ'ÿÿÿ'ÿÿÿ&ÿÿÿ&ÿÿÿ&ÿÿÿ'ÿÿÿ'ÿÿÿÏÏÿwwÿwwÿwwÿwwÿwwÿwwÿwwÿwwÿwwÿwwÿwwÿÅÅÿ&ÿÿÿ&ÿÿÿ&ÿÿÿ&ÿÿÿ&ÿÿÿ%ÿÿÿ%ÿÿÿœœÿÿÿ››ÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ"ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ååÿ6??ÿÚÿÿÿþÿÿþøÿoèE6 °ÎÿåÿåÿÕÿ y"ÿOÑÓÿ\ÿÿÿVÿÿÿQÿÿÿNÿÿÿJÿÿÿGÿÿÿDÿÿÿAÿÿÿ?ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ#ÏÏÿÿÿkkÿ'ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ"ÿÿÿ"ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿÍÍÿÿÿÿÿÿÿÿÿÿÿÿ jjÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿ!ÿÿÿÏÏÿÿÿ hhÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿ§§ÿR--ÿçÿÿÿÿÿÿþûÿˆöZH•ëãÿäÿæÿ¬ÿ7—“ÿ]ÿÿÿXÿÿÿSÿÿÿMÿÿÿLÿÿÿFÿÿÿDÿÿÿ@ÿÿÿ?ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ9ÿÿÿ8ÿÿÿ5ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ+ÿÿÿ*ÿÿÿ'ÿÿÿ&ÿÿÿ#ÿÿÿ"ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿúúÿ [[ÿ ÿøÿÿÿÿÿþÿÿÿøl JžÀÿæÿåÿÑÿp<ÿYìñÿZÿÿÿTþþÿOÿÿÿKÿÿÿIÿÿÿDÿÿÿAÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ9ÿÿÿ8ÿÿÿ5ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ+ÿÿÿ*ÿÿÿ(ÿÿÿ&ÿÿÿ#ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿ¥¥ÿB ÿêÿÿÿÿÿþÿÿÿÿþgúh-~ßçÿåÿäÿ¯ ÿ>“¥ÿ_ÿÿÿVþþÿRÿÿÿLÿÿÿJÿÿÿEÿÿÿAÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ/ÿÿÿ0ÿÿÿ.ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ&ÿÿÿ$ÿÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿùùÿììÿªªÿ2++ÿÌÿÿÿÿÿÿÿÿþÿÿóÿYóA@ e£ÿêþåÿãÿY/ÿaÿÿÿYÿÿÿTÿÿÿOÿÿÿJÿÿÿHÿÿÿAÿÿÿ@ÿÿÿ=ÿÿÿ;ÿÿÿ:ÿÿÿ8ÿÿÿ8ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ0ÿÿÿ0ÿÿÿ/ÿÿÿ-ÿÿÿ,þþÿ)ÿÿÿ(ÿÿÿ%ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ííÿ ÛÛÿÈÈÿ/yyÿWÿÎÿÿÿÿÿÿÿÿþÿþûÿÀþ8Ë& O ±Ùÿæ ÿçÿ¹ÿ8Œ•ÿ`ÿÿÿVþþÿRÿÿÿLÿÿÿIÿÿÿDÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ.þþÿ-ÿÿÿ-ÿÿÿ'ïçÿ»·ÿ´´ÿ*¿¿ÿ(¾¾ÿ&¾¾ÿ%½½ÿ$²²ÿ"««ÿ!¬¬ÿ!¬¬ÿ!¬¬ÿ!¬¬ÿ ¬¬ÿ ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ¬¬ÿ!  ÿ<}}ÿUTTÿv++ÿŸÿåÿÿÿÿÿÿÿþÿÿÿÿÿÕÿ†ê"ˆ %nÿðÿäÿîÿ\ÿ\óøÿZÿÿÿTÿÿÿOÿÿÿJÿÿÿFÿÿÿAÿÿÿ?ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ/þþÿ0ÿÿÿ2ÿÿÿ'ÜÑÿpsÿFŸÿŽ™»ÿ¾ÌÉÿÄÏÏÿÃÎÎÿÃÎÎÿÃÄÄÿÂJJÿÂÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿ ÿÄÿÙÿôÿÿÿÿÿÿÿÿÿþÿÿÿÿþ÷ÿŒÿA¥9(Z©ÿêþæÿÙÿ%d`ÿaÿÿÿWþþÿRÿÿÿMÿÿÿIÿÿÿDÿÿÿ@ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ5ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/þþÿ0ÿÿÿ0ÿÿÿ‚ÿ…ÿÞÿ ïÿªšþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿóóÿÿPPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿÿÿÿ0¿*; "¢âÿå ÿëÿ—ÿH¾¿ÿ\ÿÿÿUÿÿÿPÿÿÿLÿÿÿGÿÿÿBÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ3ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ/ÿÿÿ0ÿÿÿ/üúÿ}…ÿ§ÿýÿÿÿÿÿk`ÿÿÿÿþÿþþÿÿÿÿÿÿÿÿÿÿÿññÿÿPPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿþÿÿâÿzÿ¿9SÙïÿäÿïÿ\ÿaÿÿÿYþþÿTÿÿÿOÿÿÿJÿÿÿFÿÿÿAÿÿÿ>ÿÿÿ<ÿÿÿ9ÿÿÿ9ÿÿÿ7ÿÿÿ4ÿÿÿ2ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ/üüÿŸÿ¨ÿÿÿþÿÿþÿÿ21òÿìéïúññðúðððúðððúðããúðKKúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúðúÚõœíDÑwkÿïþäÿïÿr=ÿ^ÿÿÿXÿÿÿSÿÿÿMÿÿÿIÿÿÿDÿÿÿ@ÿÿÿ>ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ5ÿÿÿ3ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ/þþÿ0ÿÿÿ%¼»ÿWPyÿ0&ÿÿþÿÿþúÿ»ùkÂ331Š>>=„<<<…<<<…<99…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…<…?…#ˆa$%“ÿëÿæÿÖÿ+†qÿ]ÿÿÿWÿÿÿRÿÿÿMÿÿÿHÿÿÿCÿÿÿ?ÿÿÿ=ÿÿÿ:ÿÿÿ9ÿÿÿ7ÿÿÿ4ÿÿÿ2ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ/üüÿ;RRÿÿÿþÿÝÐÿÿ[Lÿþúÿ|ìk:¯ÿéÿèÿ½ÿ;±ÿ\ÿÿÿVÿÿÿQÿÿÿLÿÿÿHÿÿÿBÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ8ÿÿÿ7ÿÿÿ4ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ1ÿÿÿ••ÿØÓÓÿÿÿÿÿÿÿÿÿðéÿÿ-+køHuÌÿçÿêÿžÿB¾¯ÿ\ÿÿÿVÿÿÿQÿÿÿLÿÿÿGÿÿÿBÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ8ÿÿÿ7ÿÿÿ3ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ/þþÿ0ÿÿÿ'QQÿÿÿÿÿÿÿÿÿÿÿÿþ¨¢¡ÿ73-[|ë"ÿä ÿìÿŠÿTíáÿ[þþÿUÿÿÿPÿÿÿKÿÿÿGÿÿÿAÿÿÿ>ÿÿÿ;ÿÿÿ:ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ*üûÿyÿÿÿÿÿÿÿÿÿÿÿÿÿ}wwØ|ë"ÿå ÿìÿŠÿTíàÿ[ÿÿÿUÿÿÿPÿÿÿKÿÿÿFÿÿÿAÿÿÿ>ÿÿÿ;ÿÿÿ:ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿÊÊÿ¯µ²ÿÿÿÿÿÿÿÿÿôôòÿllk£ |ë"ÿå ÿìÿŠÿUíáÿ[þþÿUÿÿÿPÿÿÿKÿÿÿFÿÿÿAÿÿÿ>ÿÿÿ;ÿÿÿ:ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿÐÌÿ~…Àÿ¯¯ÿÿ¯¯ÿÿ››ãÿRRx‡î"ÿä ÿìÿˆÿSçÛÿ[ÿÿÿUÿÿÿPÿÿÿKÿÿÿGÿÿÿBÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ8ÿÿÿ7ÿÿÿ3ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ(ÖÉÿ°ÿÿÿÿÿöÿm©gÃÿèÿêÿ¦ÿBÁ°ÿ\ÿÿÿUÿÿÿQÿÿÿLÿÿÿHÿÿÿBÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ8ÿÿÿ7ÿÿÿ4ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿùÿ~ÿÿÿÿÿÿÿuì@µÿéÿèÿ¹ÿ@»¨ÿ\ÿÿÿWÿÿÿQÿÿÿLÿÿÿHÿÿÿCÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ7ÿÿÿ5ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ/þþÿ2ÿÿÿ 1Qÿÿÿþÿÿÿ»ÿ$~+‹ÿìþæÿ×ÿ'gÿ]ÿÿÿWÿÿÿRÿÿÿMÿÿÿIÿÿÿCÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ2ÿÿÿ/ÿÿÿ/ÿÿÿ0ÿÿÿ1ÿÿÿœ–ÿÖÿÿÿþÿRDÿþg^qÿ Zwÿíÿäÿðÿa2ÿ^ÿÿÿYþþÿSÿÿÿNÿÿÿJÿÿÿDÿÿÿAÿÿÿ>ÿÿÿ;ÿÿÿ9ÿÿÿ9ÿÿÿ7ÿÿÿ4ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ/þþÿQÿÿÿf\ÿÿòðþÿÿÿÿþªªªÿ,(&~'$ E ßñÿäÿîÿgÿ\÷÷ÿYÿÿÿTÿÿÿOÿÿÿKÿÿÿFÿÿÿBÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ7ÿÿÿ5ÿÿÿ2ÿÿÿ/ÿÿÿ/ÿÿÿ/þþÿ0ÿÿÿ%ÅÆÿDBŒÿÿÿÿÿÿÿÿÿþþþÿÿÿÿþÎÆÁÿf`|ìv£y€r`HG1>+ ' Þÿæ ÿëÿ˜ÿH¾¿ÿ]ÿÿÿVÿÿÿQÿÿÿLÿÿÿHÿÿÿCÿÿÿ@ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ/þþÿ0ÿÿÿ7›’ÿÙÕÔÿÿÿÿÿÿÿÿÿþþþÿÿÿÿÿ›ÿÿ÷ÿßÿÇÿ¾õ¬ë¼Ô¦¿’«u”Iq+b:%)Wªÿêþåÿáÿ'lgÿbÿÿÿWþþÿSÿÿÿNÿÿÿJÿÿÿEÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ7ÿÿÿ5ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ.ùùÿ9ÿÎÁÀÿÿÿÿÿÿÿÿÿ÷öþÿN@þÿÿÿÿÿÿþÿÿN¶ÿÿÿûÿîÿàÿÝùÜóØã½Ú˜ÏwÇ<zM0"iüïÿäÿíÿRÿ\ñõÿZÿÿÿTÿÿÿPÿÿÿKÿÿÿGÿÿÿBÿÿÿ?ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ3ÿÿÿ1ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ/øøÿ™˜ÿsmgÿõèåÿòãÿÿÿÿÿÿÿÿÿÿÿÿ_£ÿÿÿÿÿÿÿÿþÿÿÿÿÿÿýÿùÿöÿõûöúëöÇó”ð|ðG®+—\< K ´Ûÿæ þçÿÌÿ7ˆ’ÿ_ÿÿÿWþþÿRÿÿÿMÿÿÿIÿÿÿEÿÿÿ@ÿÿÿ?ÿÿÿ;ÿÿÿ:ÿÿÿ8ÿÿÿ7ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ/þþÿ/ÿÿÿ1ÿÿÿ*ññÿifÿ>etÿuÿœÿÑÿõÿùÿŠqÿÿÿüÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿþÿÿÿÿôÿËÿÿ}øZÄ3 sFPo @C _¥ÿéÿåÿçÿ^1ÿaÿÿÿZÿÿÿTÿÿÿPÿÿÿKÿÿÿGÿÿÿBÿÿÿ@ÿÿÿ=ÿÿÿ;ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ4ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ/þþÿ0ÿÿÿ1ÿÿÿ.ÿÿÿ1ÿÿÿ+îáÿ ¹§ÿ¤ÿ…ÿ,csÿ_87ÿ€**ÿ­ÿÍÿÙ ÿÞÿêÿñÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿøÿËÿÿ‘ÿwÓUªP†Y`n6Y*-! -xåäÿåþäÿ§ ÿ=˜¢ÿ`ÿÿÿWþþÿRÿÿÿNÿÿÿJÿÿÿEÿÿÿAÿÿÿ>ÿÿÿ=ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ4ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ0ÿÿÿ0ÿÿÿ0ÿÿÿ/þþÿ.ÿÿÿ.ÿÿÿ/ÿÿÿ/ÿÿÿ-ÿÿÿ(ÿÿÿ#ÿÿÿüüÿÖÖÿ¾¾ÿ!ššÿ/ˆˆÿS__ÿhRRÿ88ÿ--ÿ¹ÿÂÿØÿðÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿöÿÓÿ²ÿ§û›ß†µƒŸ~‰rhGN'C(+F ˜ÁÿæÿåÿØÿx<ÿWâêÿ[ÿÿÿUþþÿQÿÿÿLÿÿÿHÿÿÿDÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ4ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ/ÿÿÿ/ÿÿÿ/ÿÿÿ-ÿÿÿ-ÿÿÿ+ÿÿÿ*ÿÿÿ(ÿÿÿ'þþÿ$ÿÿÿ#ÿÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿúúÿ ßßÿÕÕÿ ¶¶ÿ(¬¬ÿ>’’ÿLyyÿ_VVÿhFFÿ”ÿªÿÇÿêÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿþÿÿÿÿÿÿþÿÿÿÿÿÿöÿâÿËÿÄöÁê¸Ï¨¿†À 9G“èáÿå ÿåÿ£ÿ6–‘ÿ]ÿÿÿWÿÿÿSÿÿÿPÿÿÿKÿÿÿGÿÿÿCÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ4ÿÿÿ3ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ(ÿÿÿ'ÿÿÿ%ÿÿÿ$ÿÿÿ!ÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúÿîîÿ ééÿÚÚÿ"ÓÓÿ*¼¼ÿ/ÿ7hhÿDQQÿq""ÿÿ»ÿäÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿþÿÿÿÿÿÿúÿðÿÁë. °Ó ÿäÿåÿÞÿ yÿOÐÔÿ\ÿÿÿUÿÿÿSÿÿÿNÿÿÿJÿÿÿFÿÿÿCÿÿÿ@ÿÿÿ>ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ5ÿÿÿ4ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ0ÿÿÿ.ÿÿÿ-ÿÿÿ*ÿÿÿ*ÿÿÿ(ÿÿÿ&ÿÿÿ%ÿÿÿ#ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿýýÿúúÿùùÿööÿ÷÷ÿØØÿ··ÿ‚‚ÿ0WWÿU11ÿ~ÿ§ÿáÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿþÿÿ Þ:vëäÿå ÿéÿµÿ!{VÿYñòÿ[ÿÿÿUþþÿRÿÿÿMÿÿÿJÿÿÿGÿÿÿCÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ6ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ*ÿÿÿ(ÿÿÿ&ÿÿÿ%ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ììÿÂÂÿ••ÿ,^^ÿCEEÿu ÿ’ÿÇ ÿìÿòÿóÿ÷ÿúÿþÿÿþÿþ…±’¼ÿéþäÿñÿ‚ÿ5šŒÿ\ùúÿXÿÿÿUþþÿQÿÿÿMÿÿÿJÿÿÿFÿÿÿBÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ6ÿÿÿ5ÿÿÿ2ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ'ÿÿÿ&ÿÿÿ%ÿÿÿ#ÿÿÿ"ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÷÷ÿÈÈÿªªÿ&||ÿ;ffÿh55ÿ…//ÿª$$ÿÈÿÕ ÿÍþQ ++ : ×Ö ÿèþäÿîÿ|ÿ5‰ŽÿbÿÿÿXÿÿÿUþþÿQÿÿÿMÿÿÿKÿÿÿHÿÿÿDÿÿÿBÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ.ÿÿÿ-ÿÿÿ+ÿÿÿ*ÿÿÿ(ÿÿÿ'ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ!ÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿööÿÙÙÿÂÂÿ5ŸŸþM„„ÿJiiùMMg/Yúê ÿåþåÿëÿ‚ ÿ8‰”ÿcÿÿÿYÿÿÿVþþÿRÿÿÿOÿÿÿLÿÿÿIÿÿÿFÿÿÿCÿÿÿAÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ5ÿÿÿ3ÿÿÿ1ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ(ÿÿÿ&ÿÿÿ&ÿÿÿ%ÿÿÿ%ÿÿÿ#ÿÿÿ#ÿÿÿ"ÿÿÿ!ÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ"þþÿ'ÿÿÿ,ÿÿÿ2ÿÿÿ8ÿÿÿ<ÿÿÿ@ÿÿþGÿÿÿ=ÃÃí..?[wÿíÿåþåÿàÿŒ ÿ/{ÿ]ýþÿZÿÿÿVþþÿSÿÿÿPÿÿÿMÿÿÿKÿÿÿHÿÿÿGÿÿÿDÿÿÿBÿÿÿAÿÿÿ?ÿÿÿ>ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ6ÿÿÿ6ÿÿÿ3ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ(ÿÿÿ(ÿÿÿ'ÿÿÿ&ÿÿÿ&ÿÿÿ%ÿÿÿ$ÿÿÿ#ÿÿÿ"ÿÿÿ"ÿÿÿ!ÿÿÿ!ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ"ÿÿÿ%ÿÿÿ'ÿÿÿ+ÿÿÿ1ÿÿÿ6ÿÿÿ;ÿÿÿ@þþÿGÿÿþMþþÿ8¯¯è&t˜ÿêÿä ÿåÿäÿ•ÿ,{tÿ\öøÿ[ÿÿÿWÿÿÿTÿÿÿRÿÿÿOÿÿÿMÿÿÿJÿÿÿIÿÿÿGÿÿÿEÿÿÿDÿÿÿCÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ7ÿÿÿ6ÿÿÿ4ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ0ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ,ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ(ÿÿÿ(ÿÿÿ'ÿÿÿ'ÿÿÿ&ÿÿÿ&ÿÿÿ$ÿÿÿ#ÿÿÿ#ÿÿÿ"ÿÿÿ"ÿÿÿ!ÿÿÿ ÿÿÿ ÿÿÿ ÿÿÿ!ÿÿÿ!ÿÿÿ"ÿÿÿ$ÿÿÿ'ÿÿÿ(ÿÿÿ-ÿÿÿ1ÿÿÿ5ÿÿÿ;ÿÿÿ?ÿÿÿEþþÿLÿÿÿTÿÿÿ)yyÒu±ÿåÿåÿåÿéÿ“ÿiIÿUääÿ\üüÿZÿÿÿVÿÿÿTþþÿRÿÿÿOÿÿÿMÿÿÿLÿÿÿJÿÿÿHÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿDÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ@ÿÿÿ?ÿÿÿ=ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ5ÿÿÿ3ÿÿÿ2ÿÿÿ2ÿÿÿ1ÿÿÿ1ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ-ÿÿÿ,ÿÿÿ,ÿÿÿ*ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ(ÿÿÿ'ÿÿÿ'ÿÿÿ&ÿÿÿ&ÿÿÿ&ÿÿÿ%ÿÿÿ%ÿÿÿ&ÿÿÿ&ÿÿÿ'ÿÿÿ(ÿÿÿ,ÿÿÿ.ÿÿÿ3ÿÿÿ6ÿÿÿ;ÿÿÿ>ÿÿÿDÿÿÿJÿÿÿOþþþXÿÿÿ!]]¾++'­­ÿçÿåþäÿïÿÇÿZ ÿ:«›ÿVâéÿ^ÿÿÿZÿÿÿVÿÿÿTþþÿSÿÿÿPÿÿÿOÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿGÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿBÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ@ÿÿÿ>ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ8ÿÿÿ7ÿÿÿ5ÿÿÿ4ÿÿÿ4ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ-ÿÿÿ-ÿÿÿ,ÿÿÿ+ÿÿÿ+ÿÿÿ*ÿÿÿ)ÿÿÿ)ÿÿÿ)ÿÿÿ*ÿÿÿ*ÿÿÿ+ÿÿÿ,ÿÿÿ/ÿÿÿ1ÿÿÿ3ÿÿÿ8ÿÿÿ;ÿÿÿ>ÿÿÿCÿÿÿHÿÿÿNÿÿÿSÿÿþUôôÿ#aa—"ˆÿî"ÿçþäÿèÿëÿÿEÿ=¥¤ÿYèñÿ`ÿÿÿ[ÿÿÿXþþÿUÿÿÿTÿÿÿRÿÿÿQÿÿÿOÿÿÿOÿÿÿNÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿIÿÿÿHÿÿÿFÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿCÿÿÿBÿÿÿAÿÿÿAÿÿÿ?ÿÿÿ?ÿÿÿ>ÿÿÿ>ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ:ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ6ÿÿÿ6ÿÿÿ4ÿÿÿ4ÿÿÿ3ÿÿÿ2ÿÿÿ1ÿÿÿ0ÿÿÿ/ÿÿÿ/ÿÿÿ.ÿÿÿ.ÿÿÿ.ÿÿÿ.ÿÿÿ/ÿÿÿ0ÿÿÿ2ÿÿÿ3ÿÿÿ6ÿÿÿ9ÿÿÿ;ÿÿÿ>ÿÿÿBÿÿÿGÿÿÿLÿÿÿQþþÿVþþÿM××÷%eedtiøÚ!ÿêþä ÿåÿêÿÌÿ¡ ÿƒ8ÿ2€†ÿRÓÝÿdÿÿÿ_ÿÿÿ[ÿÿÿXÿÿÿVþþÿUÿÿÿTÿÿÿSÿÿÿRÿÿÿQÿÿÿPÿÿÿOÿÿÿNÿÿÿNÿÿÿMÿÿÿLÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿHÿÿÿHÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿBÿÿÿBÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ>ÿÿÿ=ÿÿÿ=ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ:ÿÿÿ9ÿÿÿ8ÿÿÿ8ÿÿÿ7ÿÿÿ7ÿÿÿ6ÿÿÿ6ÿÿÿ5ÿÿÿ4ÿÿÿ4ÿÿÿ4ÿÿÿ3ÿÿÿ4ÿÿÿ6ÿÿÿ8ÿÿÿ9ÿÿÿ:ÿÿÿ<ÿÿÿ?ÿÿÿCÿÿÿGÿÿÿKÿÿÿOÿÿÿTÿÿþYýýÿIÉÉë#^^BAD Ýà ÿíÿåþå ÿæÿäÿÕÿÊÿ†ÿYEÿ:‹›ÿSÙáÿbÿÿÿaÿÿÿ^ÿÿÿ\ÿÿÿZÿÿÿXÿÿÿVþþÿVÿÿÿUÿÿÿTÿÿÿSÿÿÿRÿÿÿRÿÿÿQÿÿÿPÿÿÿPÿÿÿOÿÿÿNÿÿÿMÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿIÿÿÿHÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿCÿÿÿCÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ>ÿÿÿ>ÿÿÿ<ÿÿÿ<ÿÿÿ;ÿÿÿ:ÿÿÿ:ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ9ÿÿÿ:ÿÿÿ<ÿÿÿ>ÿÿÿ@ÿÿÿCÿÿÿFÿÿÿJÿÿÿMÿÿÿRþþÿWÿÿþ\ÿÿÿ<¡¡Ü++  ¤Šüâ#ÿåÿäÿåÿåÿäÿäÿãÿÉÿˆÿ^ÿt9ÿ)}oÿ7•–ÿHÆÆÿTççÿ]ÿÿÿ\ÿÿÿ[ÿÿÿYÿÿÿYÿÿÿXÿÿÿWþþÿWÿÿÿUÿÿÿTÿÿÿTÿÿÿSÿÿÿSÿÿÿRÿÿÿQÿÿÿPÿÿÿOÿÿÿOÿÿÿNÿÿÿMÿÿÿLÿÿÿKÿÿÿKÿÿÿJÿÿÿJÿÿÿIÿÿÿGÿÿÿFÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿBÿÿÿAÿÿÿ@ÿÿÿ@ÿÿÿ@ÿÿÿ>ÿÿÿ=ÿÿÿ<ÿÿÿ=ÿÿÿ<ÿÿÿ;ÿÿÿ;ÿÿÿ;ÿÿÿ;ÿÿÿ<ÿÿÿ=ÿÿÿ>ÿÿÿ@ÿÿÿBÿÿÿDÿÿÿGÿÿÿJÿÿÿMÿÿÿQÿÿÿUþþþZÿÿÿaÿÿÿ0~~Æ SS!UUI4 Ü»!ö× ÿåÿæÿå þäÿåÿæÿêÿìÿëÿëÿ×ÿªÿŒÿwÿ|'ÿ!Zÿ/–ÿ@°ÿMáÓÿSîæÿTíèÿVîñÿWôöÿXúûÿZÿÿÿYÿÿÿXÿÿÿWÿÿÿVÿÿÿUÿÿÿTÿÿÿSþþÿRÿÿÿRÿÿÿQÿÿÿPÿÿÿPÿÿÿNÿÿÿMÿÿÿMÿÿÿLÿÿÿKÿÿÿKÿÿÿJÿÿÿHÿÿÿHÿÿÿGÿÿÿFÿÿÿEÿÿÿDÿÿÿCÿÿÿCÿÿÿBÿÿÿAÿÿÿAÿÿÿ@ÿÿÿ?ÿÿÿ?ÿÿÿ?ÿÿÿ@ÿÿÿ@ÿÿÿAÿÿÿBÿÿÿCÿÿÿFÿÿÿHÿÿÿJÿÿÿMÿÿÿQÿÿÿUÿÿÿYÿÿÿ]ÿÿþaýýÿ+ooªoX˧õÅÿåÿêÿçÿä ÿåÿåÿåÿäÿæÿéÿëÿíÿíÿëÿÚÿ°ÿ“ÿ‹ÿ Žÿ”Qÿ(¦mÿ4ºÿ@Í­ÿGÒÂÿJÒÌÿPÕÞÿSãêÿXôùÿ]ÿÿÿ\ÿÿÿ[ÿÿÿYÿÿÿWÿÿÿVÿÿÿTþþÿTÿÿÿSÿÿÿRÿÿÿRÿÿÿQÿÿÿPÿÿÿOÿÿÿNÿÿÿNÿÿÿMÿÿÿLÿÿÿKÿÿÿJÿÿÿIÿÿÿHÿÿÿGÿÿÿGÿÿÿFÿÿÿEÿÿÿEÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿDÿÿÿFÿÿÿHÿÿÿIÿÿÿKÿÿÿNÿÿÿQÿÿÿTÿÿÿXÿÿÿ\þþÿaÿÿþYããÿ(ee„_U×–ÿÇÿñÿíÿêþèÿå ÿåÿåÿåÿåÿäÿåÿæÿéÿëÿëÿëÿéÿÕÿ¼ÿ¥ÿ¥ ÿ §ÿª8ÿ«Lÿ%­dÿ.¯~ÿ8²›ÿAµ²ÿH¹ÈÿRÙäÿYñúÿaÿÿÿ_ÿÿÿ[ÿÿÿ[ÿÿÿXÿÿÿWÿÿÿUþþÿUÿÿÿTÿÿÿSÿÿÿRÿÿÿRÿÿÿPÿÿÿPÿÿÿOÿÿÿNÿÿÿMÿÿÿLÿÿÿKÿÿÿKÿÿÿJÿÿÿJÿÿÿIÿÿÿHÿÿÿIÿÿÿIÿÿÿIÿÿÿIÿÿÿKÿÿÿLÿÿÿNÿÿÿOÿÿÿQÿÿÿUÿÿÿXÿÿÿ[ÿÿÿ_þþÿeÿÿþXÚÚÿ,iie '7 PI ™ZÔÿ§ÿºÿìÿíÿíÿíÿëþé ÿå ÿåÿåÿåÿåÿäÿåÿæÿçÿèÿèÿèÿçÿÛÿÍÿÀÿÁÿÂÿ Á ÿ­0ÿž;ÿMÿ)”qÿ:™Ÿÿ@Ÿ°ÿOÍÚÿ\ôþÿbÿÿÿ`ÿÿÿ]ÿÿÿ\ÿÿÿYÿÿÿWÿÿÿVþþÿUÿÿÿTÿÿÿTÿÿÿRÿÿÿQÿÿÿQÿÿÿPÿÿÿOÿÿÿNÿÿÿNÿÿÿMÿÿÿMÿÿÿLÿÿÿLÿÿÿMÿÿÿNÿÿÿNÿÿÿOÿÿÿQÿÿÿSÿÿÿVÿÿÿXÿÿÿ\ÿÿÿ_ÿÿÿcþþÿgÿÿÿUÊÊë88Kÿÿÿ @ 2 G2T(’L ¶eÙuþ™ÿ¯ÿêÿëÿëÿëÿèþçÿä ÿåÿåÿåÿåÿäÿåÿåÿåÿæÿæÿåÿåÿáÿÛÿ×ÿØÿØ ÿÔ ÿ¬ÿ‹ÿy,ÿPÿ1„„ÿ8ŽšÿQÔÜÿ]øÿÿaÿÿÿ_ÿÿÿ]ÿÿÿ[ÿÿÿZÿÿÿWÿÿÿVþþÿUÿÿÿTÿÿÿTÿÿÿSÿÿÿSÿÿÿRÿÿÿRÿÿÿRÿÿÿQÿÿÿQÿÿÿRÿÿÿSÿÿÿTÿÿÿVÿÿÿXÿÿÿZÿÿÿ]ÿÿÿ`ÿÿÿcÿÿÿgÿÿÿlÿÿÿI©©×'997|0¢V Ìkö™üµüãýãþãþãÿäÿäÿå ÿå ÿåÿåþåÿåÿäÿåÿåÿåÿäÿåÿåÿåÿæÿæÿåÿäÿÝÿŸÿ|ÿ rÿv8ÿ(|mÿ6–”ÿIÊÈÿWðîÿ[þýÿ[ýüÿZýýÿYýýÿXþþÿXþþÿWÿÿÿVÿÿÿVÿÿÿVÿÿÿVÿÿÿVÿÿÿWþþÿWÿÿÿZÿÿÿZÿÿÿ[ÿÿÿ_ÿÿÿcÿÿÿdÿÿÿgÿÿÿmÿÿþnýýÿ;‡‡À 5f0•P ´qÝ”á¶èÑîÑöÑüÕÿÛÿãÿæÿæ ÿæ ÿæþæÿåÿåÿåÿåÿåÿäÿåÿåÿéÿëÿìÿëÿéÿÔÿ¥ÿ‚ÿzÿ}&ÿ%†fÿ,˜{ÿ>Á«ÿJÞÍÿRéâÿRéåÿUëîÿWñôÿYùûÿ\ÿÿÿ]ÿÿÿ\ÿÿÿ]ÿÿÿ^ÿÿÿ`ÿÿÿbþþÿdÿÿÿeÿÿÿiÿÿÿmþþÿqÿÿþjêêÿ3oo—1M(rK Œs±‹½©Ò²Û·ô¹ÿÁÿÏÿéÿéÿéÿé ÿè þçÿåÿåÿåÿåÿäÿåÿåÿæÿêÿìÿìÿìÿéÿ×ÿ°ÿ”ÿÿ’&ÿ˜Mÿ&§hÿ3¹‰ÿ<ȤÿFͼÿJÎÆÿSÐÛÿXàèÿböýÿiÿÿÿiÿÿÿkÿÿÿnÿÿÿoÿÿÿqÿÿÿwÿÿþcÕÕÿ.aat (49 VQ dlx”‡À‰ÄšðŸÿ´ÿÄÿëÿìÿìÿìÿé þèÿäÿåÿåÿäÿåÿåÿåÿæÿéÿëÿëÿêÿèÿÕÿ¾ÿªÿ¬ ÿ ­ÿ°4ÿ®Fÿ&¬aÿ0ªxÿ<®“ÿM±¶ÿTµÃÿdÙäÿsøÿÿ|ÿÿÿÿÿþiÚÛÿ)TTgK? 0\8^XZ nU §b º~êˆÿ®ÿºÿíÿíÿíÿíÿê þè ÿäÿåÿåÿäÿåÿåÿåÿæÿçÿèÿèÿèÿçÿÝÿÎÿÄÿÆÿ Çÿ Æ&ÿ­7ÿ—Dÿ ŒQÿ3‘sþL™œÿ>lyëO:  K {.?)NG ´e Ýuÿ¢ÿ¼ÿêÿêÿêÿéÿè þæ ÿäÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿåÿàÿÝÿÛ(ÿÛ3ÿÜ>þÖFÿ†,Ô,&'Ez.ŸU ÊsòùÂùáûáüáþáÿâÿäÿå ÿåÿåÿåþåÿåÿåÿå!ÿå(ÿå0ÿå7ÿå>ÿåFþÛJÿŒ3¹Ac/Q °p Õ”Û´äÍëÍöÎÿÒÿÙÿæÿç#ÿç)ÿç.ÿæ4þæ:ÿåAÿäHÿçPÿÐNÿy0Š/I,nT s¨ˆ¶ªÕ«ײ#õµ'ÿ¾.ÿÍ7ÿêEÿêLÿêSÿð\ÿÃPÿi,lÿÿ -0> QZ`kvt Ž&½†,Ë•5ò›<ÿ¹LÿDÿCcE+d&2W$R])j’ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿð?ÿÿÿÿÿÿÿÿÿÿÿÿÿÿø?ÿÿÿÿÿÿÿÿÿÿÿÿÿüÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿÿÿÿà?ÿÿÿÿÿÿÿÿàÿÿÿÿÿÿÿðÿÿÿÿÿÿÿøÿÿÿÿÿÿüÿÿÿÿÿÿþ?ÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿ€ÿÿÿÿÿÿÀÿÿÿÿÿà?ÿÿÿÿÿðÿÿÿÿÿøÿÿÿÿÿøÿÿÿÿÿüÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿ€ÿÿÿÿÿÿÀÿÿÿÿÿàÿÿÿÿÿð?ÿÿÿÿÿÿ€?ÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿàÿÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿøÿÿÿÿÿàÿÿÿÿÿÿÿÿÿüÿÿÿÿðÿÿÿÿÀÿÿÿÿ€ÿÿÿþÿÿÿü?ÿÿÿø?ÿÿÿðÿÿÿàÿÿÿàÿÿÿÿÀÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿþÿÿÿþÿÿÿü?ÿÿÿüÿÿÿüÿÿÿÿøÿÿÿÿøÿÿÿÿøÿÿÿÿðÿÿÿÿðÿÿÿÿÿðÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿø?ÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿüÿÿÿÿÿÿÿüÿÿÿÿÿÿüÿÿÿÿÿþÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÀÿÿÿÿÿà?ÿÿÿÿÿðÿÿÿÿÿøÿÿÿÿÿøÿÿÿÿÿüÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÀÿÿÿÿÿÿðÿÿÿÿÿü?ÿÿÿÿÿÿ?ÿÿÿÿÿÿàÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿðÿÿÿÿÿÿÿÿÿÿÿàÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿÿÿÿÿÿÿÿÿ?ÿÿÿÿÿÿÿÿÿÿÿÿüÿÿÿÿÿÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿÿÿÿÿÿøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ‰PNG  IHDR\r¨f IDATxœìw|ÅÝÿß³{w:5Krï½€ llÀ` Sâ@è5ä!ðP~iôšN   $$@ò<ôªÁB± ¦:0ÛØã.YÒÕßs«›ÍÞdK–Ì}^¯½ÝÝÛÏ·MY(¡„J(¡„¾z;º%”PB+ j$0AÉbàÅí}¡Ðö.°„J(~À`*à‘~ûˆQ•}E/E²×.bE7§W³;¢%PB ~À7zàB  pú}MÔ•"R3ZTôâTº„ˆÖB$âPÙ[ðð‰€éÀúŽ¨XI”PÂöÃHà `p5P P> §ï1¸^=rä ‡ËÀB® $B\W$®TÔ 9÷œ”ØðoyD~( €J(„¾f¶%F;Q¾lÂáRÀEBÙh¨;¼zð}ˆT*›ÞõÀI#ÀM‚@ 98 %¤A¼ryJ,½?}¼LódGÞ\I”P‚BO H£QòªÐPfŠ2úe‚(c!Á•G€¬‡ºoC¨J]x âà 1H4AEn2¤¢{f-D"…ÂA|ò¸Çgs½zIèè›. €¾jôâÀ×PÚ=ÚÉn-}eŠxh_G€ˆBdpëÀª¶…PD'¡¶“1HoVÒÂÍ,Í’& Ž{™E ða'¥Xÿ¼»÷Ô¦÷åýñ0JÍ€%쬘ˆjNkN¢@¨l†9©‘1’e3ÙDHœj)í¥È Ó´0Wx*Í'C–辶w-K!2Û’!\ !WxO˜œ³e)§:îÑdQ²Jèîè œl¦3ʦ‡;ŠˆlÄ«<“^”@5ˆHè£Ò”ÿ­\p $b¾až “øJ{+-ïjùüsõEϯ Ù²ïII´Ö‘ÿ:>ålYÊÕtù¡$Jè> ü'Ð쎨: ám…ÈÞˆè×OÓ‚[ µø&¸ÌèyÙm©]Hßö¡“9MVèÂÀ_\²ÂÂ'¿§­}“_¢$N¨‡óf§Äså>ÀÛðŒÚŒ’(aG¢š,ozà2Ä©å$ 8LÓ‘àªÀk„ÈžP~HF£zNfž†X*Kö\›»q ìćÖÚÜ÷÷u¿ß1Îo27جßÉŒ‹áf\Df;‡ÄÕBàm€äZpîˆæ·]V<™¼‡4¯µ£JÛŒR°„í‰@ †òÅ#@¤l7&:½èíöd ÛáÕݼ$È$Tž«|ót"«Ñ½Tkmî›òKv?M×òÛ¾ƒδë»à†3M|MzD¤–C|‰ÊSìêE¥ˆ0PÔ2ÔíM(äÊOVn?ôÁ}M^ü² Š’PB{EõM¯¾êñæ–OePh5^3ÉÊÃC¤ ¡@85à Ì[*r‹Œ¯¾µÑÐääúìú¶¹t$Š!~c~9Šü À<¥Í½CòÕLþr8pÜ@zUE?°û:OBY4Äa5”EÃôé[AM]L$bâä“ZÖäůf‘J@ ùÑ8 Õµõ@€Û‹põ‰T§ëñjϤ†ÊŒù[D”_îÔú¾n†ì¨(»Nb¹ƒ|÷m†-¬¯óÛèж]`ðJ_Ÿ©X˜=s8úV2y·¾và0U„ãRQÆuÑh˜²hY¦@=rR:zè½_<÷ܧ3ÅÛãöÚ‹’ðÕ†@½þƒï¡tÛÞ(í.BC æ Hm†ºóAÔ"½ |Mí›à&±=©lÇ,çlW¢ç;f»,žAiùWA¼¬²M›Ö—£ŽJ}}’ë¶ì­cüR „p´Âücþ#–ÒAOBH\yåó‰çžûôRv0ù¡dìÌ(Gùà*'€¾n?ÎGÒ \öÀe:€ÛzœéF(Û *QÚÛ“àeüñtBùçzs´öÁ‹‰¾·™èù´·óxå 8@#ª;÷SAõ«a¼2Iù—Ê·C¤<ÉÞûô樣ÓÔ”bÿýÙsò£ÆHeör…€ßàïëÂÀÍ9ç‘G>öŽ9æÁ?çÿ:%ÐýѨA½»¡<ÖHx:Õ “išBý8^ pk j6¤› <¢ût2DeHŸÎæÈ%ºéƒç‹´·[›"ºÞÛ&”ÉV¢Hîo«ÃázÁˆÕÕ$]¾£ \WçyŒÝµ†ƒgõ'Ö”fâ䞌×Û¸ ¥¹¥ô2½}óݶ­ÝÑÒr…ÒþQyç‹ÄYg=õkàâ6?›BItŒ¡"쇡<îPÙnLpÐOƉG÷dšT}M‰Œ·Òàåƒ +\°§SvÛ‚pÛÝdÏGö0Yç$’IkÞBõ‘ fŽ;0¡²†ºPIÏãè^Cð¤¤ÿÀröšÚ“D<ÍðQUôÔøu‡RÊ–n¿ &Ù…qÌÔþ¦¶ÏÍ£È_&ß|s8æ˜G^^¹²~z±¨3PŠt=„€“P:mp à–O¡x4Õ^©ª#A9à(ójQʼâ鬾52f÷Õƒ‚qÅt) ADwPDö{Ðøè·s€Õ¨i3nGI¤(°G_õ,§9‘æ{§í H‡ƒÊ)/wI§%ÃGûD‡,Ñ%RÆ ¢«—^úÂÜ•+ëÏ*üÀ:%°ãP \€ ¼í 8NÜš3©L7"£»ŽN'‚”)-îy ª@ 5zjÆ»ðÍÇ0bhMM)~òÌDWàˆ–»¸®ºñªj¿ ]L! mužBnÙÒ,~÷»E+ž~ååy.¼CPÛú[â{¬å„ø° Šì?B¡¾Pû]HoUÃL«Ít„‘™>êBm§d.yɬәù$‚Ìts ù_{+Š ¾™ðãd~–€ó„€*‰{«€8TV†ùÖqC;¶±XšWõç çüÀ›i´&ºš/SßWk!r÷[çÑaúô~>Ÿà¶^þ>t! [Y¤ÓžxàšþüçÅ¿^±T`‡£$ÚŽ(J{ûoJ_Ô¿_Ì÷Ä4‹(€S^q„G¨à[Ý £Šä^<ë7¥”ßBZ™?gšêzO’íFô øWØ‚â`°YsV ê^‹àE$•‡¨^Æó$ö¨å˜†²eK‚ šwÓ ÒïP"e!‚Ä•Í)1…D[nؼ†y£þv´¼¶q­·¥!BòöÛß\0ï—ÀÍm¨\§¢,¡R&ìŽòJ§„³k¨žL âh•P=[ÝÒq¨>A‘?Jó¼ŒæŽÙIÔœfjñmêæšO£ëÍÛ¾ZHŸ¢üòud Ø$ ÞPAE"D߆(C7W"=ÉБUrÄ@bM)ÆïQ£EØõ;òïÔ¯¼ù4x>ÒÚ·Á ôéiæÐ_ ¸Ú1}L @J!¢òµ×>Ó¦Ýÿ 0K;¹Ë¡dØ èdoà(™`@t†;ÕLªš „!2œ^*¢^> ¼2Z"ìžP¯GcL5­µÅßf“ÝG>®ÞüŽjͨA¨_¢¢îÒ2Úe·žµôŒ”1¢¢Š½êz’hµË®ûÕPÝ#ÌÀ!åôT)(×f‘²Ñ0Ƀ¶m&~¡óòY ¶mÿÁ öéðȵürsËó5ÿ?ÿù‘¸âŠWÿ5|ÙV‘.ƒ’È`ÐÍ°úGüɨè.ô®œA¿ê#@Ô•Šô"í)Ž€ÆÌ`mâ˜VÏ×9f›a#»ÿ.GȺ®.ŠèÏ¡4y9pJËGaúä~ ë[IS<ÅÎëB!èÓ¯œ²¨Cš0Õ5í¢¶»þž{yo6òzòÚ¶ƒ\‚BÐÛéõó<ìS øùmä²±1&þüç÷__¼xãQ]‘º4J.윜êCºê`Êû^…å #H/‚ðd–àúZÛþ1ÓÐí0¢CÖBÕÝÕLà‡P½ó€Jøæ‘C;ºš­[“üø²=)‹8ሓ‰°KÊËuMXÈÔ6ï®Ùn[]«˜²Ú›æÖšÿõN=~[gµ¨¶~G65yââ‹ç×ßvÛâY°c†÷¶_= ÀAÍÈç‹0'bz™Pw&²ükˆT Ré– ¶HKõŠ§Èjó´±mj÷¢ÏÊï¾=T8â=ê +$î[÷eÏ“ì¾G-§ž1’­[“ìe?znVK¿@Û>ØCŠíñÕó™ãfžBØEi[žºñ÷Ëô‰mkÖ3­K©‹¥Å 7¼µù¶ÛŸA7!?|õÀ@<Q~êGßÞçBÅAÈÈnˆD¢i«šJÊoÁ²-¦Y_‚Ìt=þä+›4°ÕßÏVd²¯‡¾ó£xe’ªåaj?ˆ =ɨ±Õêp·&™|j/&îí7¥åF¤ŒkfzmÇÛë¿›eã×›ùó•›ïtØ:ù¹~Z°ŸßêŠÊô ¬å®»>¼x<ï ] _ @0É!À¹S˜Øc6Ô~W™÷É$¤RŠø)²D÷·}íß&ŸÝ$¼9u¬@ióQmèVâ̇4TR› “Äcÿ ý ÓµuæQinJ1v×Œ×‹ì‹ší¼›íÃ^L ¬-æz¡|í);¨žÅXù®mƒ)iƒºõúûz·^ÓPƒ”é–=¶\|ç;/Þ¹qcü\r;(ty|ÀeÀ U2©æD¥ñÅ D¢ R¤D–ðþ¢kû6yšar‰îÛWË—QQ÷÷Q}Úð{ÿZTTK¥9yìp\Ç!q³k55ua’ ÉžSûd 1 OK×פ·Ç·.¤¡‹¹n¾k´‡ø…¬ f~]ûëæ—¹o6ý™@IsÕÍ7,7nŒ‹qã~}|Û±SegagvŽ.r*™>äNÜð®H1‘L"R[!)”ÖO’+ôà] ¢Z¦Ìàâ¨>ìKQÑ÷7—T¾¾#¢Ìž>˜¦Xš)»öbÆqýzö.#Zîà¥%ýù}‹Ló7žYã‹›ùô´BÚÒfv*»Ð±B&|±eÛö Á4áõÎGz€Ï,·p(eö»rãƘ8öØç×®_?•nH~Øy-€ß‰r¾ßûldíw²2")•Æ÷Éî“?IÀ¿ç›òºðo~‡"yxEü(ý¡Œß¥†X,Å´}ûqø¡‘Baõ⸮ÀuýÂõµ-­-¾¸¿]Œß¼-f¼í:AMx¶ü…ʶ•o^#¶ Ÿé‹ézô?×´\c;wàõëãœrÊKŸÏ™³z_Ô€än‰Çá’b^ †¿A–o‚¤D¤„"‚\Ðòšùd'³nÎdZ b.„_vˆüK5•Þµÿñ±4lM°ïe½™ñÌ l¦¹jjÓêÅjçb h7Ëh‹ )$˜ ™àm!{[„ˆy LSßOó׶þûA°õ™èûÿ÷S>ù¤á4º1ùa'°*ö…¦ùÔ·…sr#oC4¯‡DR™úI²‹Oþ–×Í'~%–£zÄý†­«¢vc„ “k9øÐÌ8¤cÆô%ë4(Âgo¦_îoc¢Û¶óµ±ÛÊߢÕ9ˆl6Âk}#Dò]»ÉKn ÏÃß:Зͣ‚~R:üýÏ>ûµŸÅb©ëÉê–èöØ—ßDdzï ÿF„÷„ØÖ\âûZ?ÇÔ—d> ‰jr{ x Ê:Ìì5ˆ]÷ªáäÓG2qRŽÁ'}p”½XŸ¶½Â B·Ç5(¶m±F‚Òmõе¶¿6_Ë A`æ7×~ù¶È¿¿ìË5ùUÄß•K–4ˆñã¾.2¥×¶¢»»×Çõ<•±=ôC6mE$ òû¾>uÿªQ]î^Ÿ‡¹ôŒÝ™|coö™Ö‹ºº |[AʦÒç’ßF¾b×Ålç3ómåú‹ÈkÖ5_YÛR—|ç™°Õ;¨ÃOоMÓëB -æ¾¾öø„påÊ•âœs^y ¸$ï-u#tg àæ»CÿŠˆìƒLW â^.ñ}Í/!û~•£:Úü7ðWØsLO~ré^LšÒ“AƒËq]åfýwhÝÏÏ& 5¹Ú£]må:Ö× X=(¶¿½€íbîIGÐÀÿ˜®í}sÏÖƯ›ú6íV®lfæÌç>üè£ú}Q w tW àOÀw†?Ž§É´2ûãdÉŸójŠLâÀÁè~ÕÜô—©|ãCB"„ê9§šxü}IkÂÒü7ó_L9¶óƒÊÈWvG=è9yǃê¶ÓÄ÷5~®ϵ$¹ºÏ3ðûùƒeòê«_›7'&’m—Ý)ÐÝÀ0OŠ2Æ{B“ –P&"á£uÅòÍý°¸ F,ªâÊ_Oä»ß«²ÈTN¤^m"‘ŠÕºùC1BöΗ7ˆ¼m6¦[¡Ÿ—è¶<ÅÔÃÜ2V}r›>O;î¯Mâ•çÏõ/¤®¸è¢×Ä?þñéÑ©”Ü©ÈÝKŒþVu ã‡ü™!šJëû?N&$«›ûŸÿ„ªŸ…8ò˜!üô•=Ùe\o ž èù/gP/»BB ˜uÐKå/DîbË+t^ÑmÐÇúë×*æ~Ì´¶<tM­Ÿã›ú~¿ì {rŒíl¹B ®¸å–øÍo–\€š‡x§CwÀ¿U}inE&D< qMë·˜ü¾Ö£¾ôò#8b×Áœ|÷HN;m<ÐŒ”Í3_'¾éç›#å‚„¾¦Àñ|VA>ò"¾4þ¾yŽy^>h;×vÝbꮓ3(¿­s~/úböòƒÜqü6èF&è'.\Ï}÷­x 5EÊN‰î<[5ƒÝü2Ý‘ÈGþ0ªÏ€ç຋&sÎÿK¯^åÚœs¶9yÀnú²0Î7ÓŠ!†™^LÛñ  ¥B×´]¿˜zÛÎ/d}{/ܾï4‰ê¶©»~°Ïÿ øË.ï¼ÓàrÊ«O½ÿþ–ÓQC¶vJtmà0W+öaÈûÉ"žÎúû1ÔZBö~¸&lªåž¿Ï`‰µ8ŽÌ˜û…ˆïûù´´´ì­ iðB>z¹nËo;'(òn«“íz…,€bµ}>›ï Íç“Û?f ô~>% T{…<ôÐgåœ9k÷F ÝÚiѵ]WìÍ áO cñ,ùcd5?Õüï‡ÀqÇ ãW÷LaäÈ* iÒÓ§îÐM\sî[”Ú7-uëA¿¸™ß<ÏÌë—a¾Ü¶~A0–ü’–t[=Ý&@‚|mÿX¾4[õü¶:Á â9´îÚ«k}=oP?[{™œ5kŽ˜3gívròC×7‰0ßíûSD,™ ôešùZÈ/ÉþßóãàôÓGñ·¿ÍDùú©Œ¯o#¿©õóÍVk Š ËÀöâ{ÆZ‡)tØ|c›ûa–ŸO›çkƒÏW73O1nB!ë&_=LÁcn ²Í€zZ>!`"ôËFüÃâØc_Ï<óÅTÔ÷‚wzt9Pul}‹Ýž\4øOàñ ù}³Pÿa¸jþæô³Góß¿Ÿžé¹çµ´í›³ã´Þ z™@3žN@>l盄/¦)²)¾=L÷|yó]+_ò]dž yû × *GæÆüɺßàÈuëâºë>|oùò¦k-Þ©Ñ¥ðϲ1ôë{²9…Hx¹Ý{%™Ÿ*à4(Ö剗g2irO²#õ|‚ÛæëõGnêÕ]°“ÌßÖgËõa ÐúÅÕRf^¿¾ú¹6â›eë6¯™¯¬|ylå"¹YF[zæË£·ñÝ¿Ù)Èf?‚lËŠø#N:éÏ,Øx ðy@¥vZt%p…SÅ‘ƒþŠLx­5¿çÿ×þ,<Áë‹g3aBm&ØD~Ý"Ð_Pýx>òÒX~¶.§¦•áCÿ ˜ÐŽëÛAZ¸½Gÿÿ~ÓU‚­¾:låØÊ,Æûôëæ7ÕåHÊŸ7ËwZŽI™%¾”B†BŽ˜:õ¥Æ×_ß|ªÏèW]Eì‹ÃuoDºãMMÙ¶þ–N>¾ ·8¾ýíQL˜Ð;óUÈ&ùÍ 4ò™BÁ‡iÆçÓÀ&éÍ—Õ &êÄó‘ÖŽ·Åðënæ5ëä’äÛrAç  ¦Ä|°i~u^&jß*¿ñxšÆF5 [CƒGS“ r˜7Ïãµ×<6m‚ÇOÈT*!à³4jxØW’üÐuÀUµ'"«NC4ÖçöïO‚zÊP߯ûøÞìÊ-8 Ó¥Š'¿™­ÉD– ×41MAãÃŒ1˜e›äJ·Õ§Ð¾_¿|BÌ,×D{‰^ì¹f9*Ÿ"»ž®ˆ^_ŸàóÏÓ¸®Ãš5IÖ¬I -êÅÛo÷¤¬L2~k×ö@½S€=Qþã Ï&á¸ÿ‚†«Š¨ÐN‹®Ð p†pøŸ‘¯Qžœô7gÖT-ëãàü)»ðû;÷£õ÷yÚJ~(ŘÜ:‘0òèkÓ4ׯg‹È"½M çˤÙó½ÒCþNIù¶ó5Ñù¦{¯.˜;w3ee‚>ˆñÞ{i"X¶l8Ÿ|2–P(ɲecÙ´i J]ŒFf¶Çµ–Ê.pâÝ°âŒÀJ}E°c-€}IñŸ~C¹ŒLJ„¯ý[&ìô¹{ìêÍ•¿˜xZÀÏí7£þR˧j Ì™„±ß$¬¹í—©_O«ý%­ mÖKš™OG¡{h+у„]Ðv>¢ûþ·4ÌweίXÑÌ«¯6 Þz+ɼy+Ÿþ£¾ë6³iÓd§¡ÞŽ^™% ôF}1èÞZ\4 ‹\6V\pÂW ;N8DHñýò½˜)ùýÙ|Z¼`Ì…¾÷GùåÿMbРr ­ êÉGz±õÆ>ÆZ‘mmúAšÖF|?Ý´6Ìk5 êÇ ¹hùMl+Ñõý¶huíŠÂᦛ6‰Ö®MóðÃiÖ®…Tj"‰Ä!‘ ™Ü—TêH²j *³gë-÷¡ß›°AÀ_^†ÏÖVþ+„'<†»uœÝû!iÌà«s4ô+Á9çã°Ã†iA?ÝÐ  7õ™yL‘_@ÙkT0gÑ£êæqýºº2ëc 'SèÖ„Í2ðä“ûÇòµ$øyÔ±¬/ÞºÉ-•Ê>“tþ8Š²ã®ÌÔµpmÓÞÛ+<%3µÿÓV8ïg¨Ù KÈ`G €N õ8¼D²9ùo™Ñ§¸z<æ¯/˜ÏŸÐL³£OPÀÏf曾¸IÓ ×É©çÓËÕ[tûÐ-ƒ òmû¦búþ¶º™÷e7ýsýq?ÂõõI>û,ëš5I–/OÃ;ïôãw†‰¤yçþ¬^=ª=“¬Å5è…Ìôí ‰2ý_pÞ-ÀMt¡n‹#—•ïNeÅ,dsLiÿƒ€ÒüÍÀMpéÕ»³ï>ý5ÓßÔÊù¢ýhÇ‚Ì~ý¥45ªI Sófo(›nÜæ˜.~ óúA`„öÄò([ûã¾Vw˜3gá°`éÒ8¯¿‘¬\9˜O?Ý×M±jÕ6l˜ˆÏÃ3K*³®ÃŽÎ&zÐu…„‡\u7pc_¼[¢ó€`(p^¯@*„HƳ¾¿ê?ì\u#\pÁ®(Ó_'¸¹m[›ÚY `'¤©µý|:ñ³7b»9»Å` Û9¶ š-M/ׯҲ]jÇùÿö· „B°~}š§Ÿ–¬[® Ÿ~ú'ACÃ46‚"z ŠÜþŸQP÷®Bô–ëJø·€WQ_|yQÀ3„U—[:¸RÝ/$¿ªœF(z²©I}³Ïÿ@' i½üž}jµµ!¤L˜þ63ß4—ƒ¢ý¦©n’Ív~¹mdׂùÎó×Aù}î]+ÂáÆ·ôÐâ IDAT7㺒õëÓ<ôPŠÕ«U¯¸xür ‰”}I&A™éÕà r¿gn«[W#ú|sQD˜„Èù _‚X9¤~ËN4ÿöÆŽpŽèûSd"ŽÐ¿Ù×òª;ÀpÌäaŒSè3÷ê$±Þlî3óB0ù=˶þ¶õe7Ý_[ÛàÏ?ßúzé´l‰²§ÓJy„Bðüóóæ¥ih<ø`šM›<”ö¾.s^À·°GØõzµå^¶¯+!&²®M õz¾”†¹)@\%áþ$Ä\ày루ï3¿¡º‘•Ðt¶¸Ì©$™‚hl„´éûƒê•ý œuóêêÊŒ‰¾ÈÙVD×g¬QÛB8|þy3Ž#©¯O²aC’pX0~„W^‰‰H,ˆòÁþ'Ëö¦¡ÚÈg¡Æ¼Ûе÷ª ÑÀºÌÚpÇçuàõzX´ÅúùÀ+¨wõ ÙKØNèlpêÀßI4ç’¿E/zÀ8¼ß`8¨¢õ‡:‚:û˜ÖäÑlc7Ëó+ GëÛ‡ÖƒUZÆž#,x{+!×#ÙØȇ6ÑؘÆu=þþ÷ID")>ü°Ÿ}6eíLÌlO]5 Î;’èë„úÜr XlE}îÛ*±¥æ~4¢|¿£$Ù‡Àg\ñè\°›SIeùÁ÷T·ŒÆG;SPõlˆ“ÎAMM™Öìg#u¾–³ÎôímI¯0”?ž;·¼‚w–mâÓ=ciž|¡ž-Žžã^kb‹SÍÓMG±zùDTÐÍCiô4j&ô^AW ¨ßŽ$ú o£xü °pÔC|+¼õ*ê«Œ.ðJ*6¡$D ;)Ž¯˜ÊÈÚßÞ€¾+Ê9ð~d»ûÚ´µ?!¤nöC.¹mxÌ&5SóïûÄ"Ľ®aýª8sßlâíÅ™‚Ï7§¸°IOK&lòøÙIM†o3–?sW¾+ÔeGý}/¡‡/g–€ÔH¼ éøì ÔÄ.jWê*⺠:Gªì^w.ÈrdDí˽¸ÿqØ`†¯E™>Iõf8±uí±­DkÒëÁC?O~øx!\žzr§Ÿþ)6á?9‡é½ËoÞ|ˆÁ™ÒÃd½|sRꡤ©&Aì¤ëh¢t]©FË=‹"ú¿€'Qvæ£BîQÏCbê6õ‘V¶i“Jè¢è Â8§øä×ß’ºÅaæ£ɬßL’›æ}P×^]ûëiÛ'?á|â§R°ä£FÎûá*Þ{o.½ê6®¾ð0•©ò˜ÿPQvD-[Ø‹÷x‰ÉEä.ù"ì"{¿±Ì:ü¢I‘{mîC³ ¼ˆŠ²GP6ýü<Å-¾£³\€Ê&0^ôWÚ¿•ù_\ãÆ÷`öì±HÙénÓØA äúòº`‹ ˜‚$>ù››Óüâk¸ç‡Cø1/<}9a7{œiƒ¡ÇxDýûËtHPƆ‚ùjD°™¾\‹°"{HÀ_?S¸ xd-ŠÑaàæÌz=J»—ðBg€*`JÕ!àôE¤c*ü«æÀOoÚ ˆi³üØ4º¾.dúÛ|fË€>¹ óÎ]Ë3ó&qçíWpè¡ãêä9öωÀÁ1zýƒˆþ¥€QáRTûiHÀ+‹TnkÌû7ÊõËß.XÁ¾è PÎÔÐpH¥²äoÑ»TËîr8üÈÁ´ž¼òk~é¡5áÍãf×`KNÍìŸ=û]œŠŸ2÷¹óÙul@}ì%ô¯€‰{À³ÿÈ[.@oê™Î¿y‘ƒµzÙüñBÍ‚Fñö Ñ?ƒMo•‹à‹7QOsQ¦ °²`EJøJ£3@¥Û‹Ý£!áe½z=øÇRøî¹c‰FÃHÏý·¥AnSžî× ý|»öÏj~ÉQG½Ã~ûý„^x)u5åZ P?!cyOuýaÓ­ËÔ®¢™Ñ|¤nŠÃ_OxK ù"ˆ2hz6ú¾ycf™u‚Jh#:Z`º;ÜHo«òÿs´–·AÝ7ËPM쯛ZÝv,(úŸ/¥âBÐÔäñŸÿù&\ÊW\N4µLi¥]`ý¡ßä¦/lq}¹ÄÓ(}¾€[?è%üz_òAðÖµ¹â%”Ðt¸pª8°|OðRäÌÚß‚°®½nRfž?›Ÿ¯ïûÂAO÷ûøû¶È¿¾ÎŸäÏÍÛÌO–ñôãGç'ËyÈú±•bk¿¸À Ðà‚Xé ¹IUèUT°ÍùeéG¶æ ±—PBG¢ã@Cã íåNÐ(CöŸP]&™ô‡ƒ‚{`øûæÀ›|¦¿^¾Ìj’ʧk%ß•ìùÖ›0m?EþܯOøBA.[ñ…xåµ…âïwÿ¥ñ™×ž\†êw *ð¶ 5t­¶ZkPB ƒŽ_+Û™J#ôVý¬‡ãŽN8dvÔ;Ùýu!_ßÜ/Î ð{øýö·ëØ+¿ ~ø}ä’µˆúön¾Epï½÷Šwï¾þ¯G!ñ¨¶óR®„.ŽI§"»!âëÁÅ3Ÿù6¶Š–îô@~ÒšÛº 0ÓmçÖþ+Wƹã¿×ñ¨vÊCüþ°àiøëS0¾ÒóŽ#o½õVqÙe—ÑÔÔt>p7%¥^B7‚S8Ë6ašLƒL« yŽù/Q ûú B!?±PûP`>aQ\ä_Áá²Ë×°wɤ´ä~ãu8däí¯ ‡ßßz«¸æšk–655ÜF‰ü%t3t¬àpdùTÕþoŽàÇE}çïuˆ”ûããu´§m?_ÇŸb!¸ÿ¡-, :üù2ÄUÇÊk?Q\ýþ+nü P¸á¿„º :ZP1dªµn ‡Ÿ6˜!CƒæœÃ<ƒÜ‰;‚ò˜çÛ øÝ-_P‘’L"ØVøpÃZqï†gΧDþº1:ÚHzé\<’)éåëñgë £PšÍ:‚à‰y[¹>ÝR½Vð@>,GË”Ï_B Ý+=ŽGz ½° †yUTT¶ÅñK Òä¶ôBÚ_5ç½óN«7¥L°]‘À2TS_ %tkt´ @hBfLêV@ì³goª{”ig´ÕB¾¾&”`øô‹$ç%¼–ɶm¹2¬ÿ’R; ;:\€j ¢ *T…¶yÛô‘isÕ ›×:¼"%”Ð èðÑ€…ÂnùÏÔäÃj(öZŽêáW[ ½û@@ŸÿðÚµq6n\TdÁ%”Ð¥±ã>ˆbH[L×߶ Cöæf8ñ$øå­ÁY¯¼®¿¾3&ì+¡„G§¸vÚBJ§©T`–D}}ˆàÉùK(¡[¡ €©\]/^Œç7Ž?¾8¨ÓªTB ˆíï”»-Ód·çª’='UóÊ«/“N €Ã?`¨ã¸AÝ+¡„nƒN±„ ¦¯ç×D—[Bжm¿8H)>´‚Ê H&ƒgת®®eܸƒx^z÷v]¨„º:\¤×#ý¡¾žˆÂo­gkƒN¸œ\Úú¥œâ…?ÓÏ°aa.¾øâÀ|••rúô)C€Š.¼„º(:º+ð»[îA8e*J`,“ 4nMvh5Š×\3ˆ9sžüîÁ¹(//çœseeUÇCË”¾%”Ð-ÑÑ]$”Õé­,€p{ D^­o¢=ùŠ=G2sf Ë—¯báÂ…óÿMœ´§üW]Ú²²Û=‹,¼„º:Ú(s4Ðêb"aÇÉýº®]d˜„nkSŸmΣ:Râ8.gŸÝ“ÓN;³%MË€"Ž¸~ájyJ<>¸Ó†Š”PB—AG»Nó"¡¬È¡lž¼wŸ­j,²Šù„€ÐÒ0ÒÌrìPßãŽ;†²té2}ôѬ™P¼Ý€sáÞ.îŽYÀ;À¨‚(¡„.†ŽO5͇P(Kþ– ¦©ÀdHÆÚ¢ÍcmCKQ|óàUWÕpÕU¿lÙ—i z öêøR ÀCà̆rþ œŽê]Ù{X–PBktx¯›È(äˆÅаš4¡M‚_œ¿Ü}—]±¡?k ÿù´±ö·Í ÆõiÄý¯éÛimßO †”’x\2pàÎ>÷r~uá÷àì¿ ¹´Õ™Ñ%oq+°>٠漟Ò×zv„¶Bª~GW¤«££@84ÄЧ‘‰>ˆfOͤ'£‡Ë€»àÌÏÆpÇíG8b#¹¾–™uŠÜIÆô™ƒl“ŠêÂÂ/§°xæ™-œ}¡Ç齃½²ð?“ ÿâáÚÚ͉Ýv{Ï …ò~:Ûuáý÷áóÏ ]B›Ð `Ñ*`ð.м¹cëÔ5ÑÑÀuûðR¿™> ÐŒ²$¨ƒ<}oˆ²üÍã)/÷‰ì Ÿð¾U ÷´Å&ôï Ø„Ea!ày’ÿl úù:>òuýóKK‚\qð Ñ|ÃP^ž·üÊJ¸äx衼ÙJh3âÀbÔ‡T×­†ûù*!ô$¤–íÐêu!t´¯*eŒSË™u”×î/iPò,øòâ‘°«}Ì¡õð_›ñ­3ƒ‚&Áme櫸Äq?ÿÉ@V}éqòÿlà©€’ýH bô)ÀÔ©E]§W¯¢«TB›°7p’„ÆAðs`îXxê8xürTÐvð_;´Š]Ý (½^k~ œ0¸R]Ðm9 T«åškÞDÛ\–Ü !ôö“Üþ1ý8–mÿò¦Ð{%R¦¹çž‘b-û… °|âÌÇn»Cß¾e–ÐY°)5’ûlë\xß…#¿ 5K!¼5Ê3ßõ;:c0Pcz#ï'—먿Å׿€²Ê‡ÁﻄT*¥Y:Áý4›00; ™D—ÆùºE¡ BÖ@Šÿýß‘Üxë ëâ\àC-OËÙã'@Ÿ’èšÐß ì*àŸÀf ƒ1ó€g€Ã@ôß!Uìdt†hH|Âë©åà†”àêNßÓO¬"W<äë!¨“rÉ ­ÿl›°Ð…@1.AšsÏéó gű5ÌràBT¨I•…=¦!{„ó–UBW€+BÀuÀ‹®Ýö~äÝÀYé¹ÃªØ è¼Þ8äz¤+Å[âÕ68®ýù;@4ãØÌü -oKÇØ& •(N€ÇÔ©•Ìœ9Ó:¢ÐG4 ú¼ñF`–¯8Šy=ÓÀ”6Ñž©áZΑ𩀛$ÜÖòàˆ6ÖåÑY ð·¡òM±Ä¥RúÍ(#¸?|OîÊÍ·MCÊBøÄö‡ ›€Ì>f»?´ÂH×ó ­Ì —'{Ž ÊVD—á±xqœGm Ù2ÊÙ2¹“šæ ‰|Zì«äVäË›6Ix Áš5þ3þ9ª‡Ù1äŽÑj—0P@X ì'a.þÐÆ‚º,:K\WuWô¹âѬÓkò"Œ¾¤šç_™ÅСdµ!+ÀŸÄÓ'.´î¨[¶ŽBúq½ë°_9Œ²ìFõeÐoÛ¯³ÐÎÓÛôŽI~þ|ú(jÐy]aÚGÓµ2÷Íž›í»ÆÝwÇhhˆñôÓi.„D¢†¦¦Ã‰Çg3:Tÿsÿ™#ôŸ‚¨†K%àƒðåLÝ^ÌrR—ÆŽ°ëGΣÊÛÑœÎÆZâe.p=œ¸t·ÿ}55~~[,À ”6öMŸìAA}­çñ5vÊ’×4Çm±]㛣ýã~™zºY}½³!ŸEEž´ ça^*œ—}Ý››%±˜Ç#$¸újÉš5#€Ë3Š¨sË{%!)ÔÄ｡éÚRD];Bu’æ<¦`Ð[LäÃŒØ`#‚Mcå‹qt6üçT§BÂÍŒyJ:–‹ð]…æfÉþ熚X¿~4j¬P”â‚…& x÷SàdÔ0änÎ;£|4ìa1 šãj¢™Ù3$Püú>åãeÇQ]í´MbZºP0-1ƒäC/Ë&üˆ¾Í °Y6K!H0uGí¿=_©BZ?Ÿ•dÛn¦[MM’£ÞÂoxlÚtðc Šl°9ß½I ¸#éãP}Œ»«#ȶÄlëÖÏ[Ÿò1œ~z9“&…X²äÖ­›ƒçÕ»’¿9U¢"GJ(Á¼o·˜Üá"];ª#ê;Þf΋îB8² x©l³`Ôó¬Êá¯gÖ‘éß¿*O@ЇI~=ݶm;¦“S¿†.üëc¤"´žžïÅu~cÝK{®Õ^ᔎ±íïÛž©­¾ysŸmVHFr™=»ŒþýW°hÑ“45mF®#ø½ó…ÀþªÂðìl`5ÊŸè²ØQ ^ƨ"ÉÕ‡ =7kxd¬€$0š?HóÊï¿ä”3FºäšìA­6im{qL-Œ4S ä×&ÁÂ%ˆÐæ(ÅbHd ÎXÚJ~ó™t„*4NĬCu’[o!”5P]í°ß~Q¦NM³zõ|>ùä>à( 7ö.ö“08œ é¢Ø‘CQV§7pRù^T”/­¬Ðº àPØxoœèV— ͸:1u‰¬w 2ÿ =Ÿ¿mŽF,ç˜/•CÈ'(l#Íuélu,Fó툥=Åv?…Ž™‚0è™*›œ*è·ä|,ìixQ÷>4ƒƒîGn`ÏXüth´M*´c&ùõ|~^]ð¤µ|)ã¸y~ë@ßüùì·ß F³té(rÊö þ-YçÚk7¶ûü!CB\}Ÿ63~3ûí÷ è°qãjkÛ¢oòóG¥±èù̘~šžß<.[… xì»o=ð#à¦bê/á<·¿ | XWà¤NÇŽ›¿^Çå·M 90¹}"G"ѹ“‚#™°æM\sÅ›ÜÿÈÁôïÉtv[ Ëjeؘ]…1òšºM›û} õ "PÏ?!Û*a«˜fÑ¢– Ò™<¹Ü¨ƒž¿ò Šyóš¹÷Þ†"ËjN¨nC]ô{5*Lmm$³W(²ï#èz¶³aäÕŸ§¹­ÿGúì+ß"ì³ÃK/Usè¡7‹•—¡Æ¹˜Ü á­`á_€³¡bMWê4˜/´ÙñH³øËê ˆ‹Ïaa•Âd!!àrxyÃZ~}íbÀÍÌä/þxþ ÙÕ–  š~ä =¯ùò9d': iÛ¦ßo^ÛÉ!É.»”±y³ÇæÍ’Í›1ÙjI&õº¹y—E‹¶íóJ8™åæ7ïs…[ûs¶Õ=_¹XÊ0Ïiýœíå¹æ„4¾[ „Ó§»<õT{îyp4ʲ²Ö$P+à â]‰ü°#]€\<Õó;Ö÷·ˆÆˆ‹¬;ÐÒ7  xÄ™pÅ9{pí û esf8®ÙþoºXÒMSÑfÚÌq½<È}„¦ÙiÎS«½&Nüwßm_ïÑçŸÎ×¾VUTÞ‡®gõêö|YÝûGT3rd¤`ný¼‰?æÝw•¸ñƾ\rIoKÙ¶í|šß¶í£Ð(I›[Ô_CjDZwX¿N9esæì < ôÇn øi¯‡ÅaÓOn²ÓÑUÀ B¼0ädôhDSS®ð=zðˆ3àü³wáÖ[@ʸ6o€­g ž¹ºÙ;Ðôù!÷…ÐͼÔÏÑ·[wŽÅÒTW¿C*E»°iÓnmô©;Ùg‹yTWÿ»åÞæÎÁÁWiùìçkQf¬Æ–?±óÅLAßZ€«æh‡†8üð ¼òÊ8à%Ô@¡@HxLÀ±@zÈUù2wºŠø¹[Ë5ßCzƒñÌ88™nÂ>ÿ\`!ˆÙðÑÒc=º)“BÀf ø¾©¡‹A£ mÁBý<3/,X°•}÷-üµ!FŽŒ°lÙø¢ò&“’ÆƼ(Ê‹PHPUÕ6A³`A#ûî›%»|ù8jj —!™±>L_OÏ·o35¹gI·Y¶±ꘊA)·aÊ”¼ñÆ.¨‘ä³0SÀs@L¹"OÅ;]é#–?NofúêosÐð—‘^ÂË<7HdÖ¤€A΄I{=Æ‚G±ëøcÀ‡”%ôà èÓÿ|¿¿g9ß&ôþ ù^F?/,ZÔÜ’rüñ½¸ï¾1yÎ <…qûíkùÞ÷ÚßuÒIuüã#ŽÚ5·~oÇ×!n—]ÊX²d\×*Dxó÷ÿoÿ?öƒÄ¦»‡±ïŸ§¿SªLE~5Ìë¯÷DˆKµr̦H)`pp¼ðcà¬<7Ò)رAÀÖ88¶„†uW#"‘*(A n€†I;ôYÞZ´‘l`ÐpÓƒ@¾Ìóó™B=@”3¹¥lAå´nw^´hkËöøñQ6oNg‚€¶%7(˜LêÇüË›oæ’±­Øk¯j²ÿ@ÐRF6tj%Š¿V9Á溴³ mAB󿳇‹é§€q,[¿…à…*¨¬ü5ðK²MÂ&ü´›ˆœœÒÖg´½Ñ¥€ˆGo¾‡­±§¹¯—ʈškøðÙ”FN=ùEžx|5BJÿOµEýý}?R¹/F¡óô—LzëAÎan -jlÉõ³Ÿ­¦®îõ¢—ý«ø&½·Þj,œ)&M úN†ûПSûÀ¤I~Sh m° [ ‘­ÂÖ*aû¿Íw!÷=B2cF÷ß_Aÿþ×ÏfŽ¹/“%ÜP œ euÅ<›ŽBWŠàöF¤×sex ¿x¸{#ã)DBdã-ñl‘Iø ôz°Œs¿3Ž_^·¯6¡¨ôÖ¶è°m›€üúš<ûzìµmîCm­nÉlorcô<¹yÕ½-h¹·çŸÏ×¾VCîsÓ[g ÷yÚšZ·µ¾A@½>ÐÚ”´ºíçÍïÖ]ÏŸþt?ûÙÔ×á'æ©ÓzTÂùA¯›aC17ºÝÑ¥,€ôz¤Û“ë“køýg'ƒ÷¢ÌÉ›Q4KÀÊË`ïã\w㻜þ‹QIîgÆlZÁÖþlÓ즙i¦›ë EiGñî»Íí&ÿÈ‘QjkË°k»Ž\Ll³˜Þ}·©åÞ„€É“+È·øXØ(W·¢t­ß+ Èj°izý˜­‰ù.èå #[ú€äÊ+k9ýô¥8Îå™|A¼î-á{@ô,Øжn–Û])Ø‚ôF<àÿy T¯û)§ {G6ÐòŸú4éÇä\àë …Ûú­ )®½n2C†TdÆè>¤/Õ! ’Ú1½µÀPÔ#ÄfsTæ2ƒdY³üW¿É¥— x¶ˆrží© IDATñxõÕ-Ì»©ÝçïµWGôùb{0nÑ¢lG—Q£¢ÔÔøâZ×ìþ=ù¯Ÿ?Ñ‹°äÕ¡ÿ‡ÅX f~}ßyô€Ÿg¬¥¶í×Shy\|K@ A$"¸úêž<òÈÓ44ü¸ˆÖÿ£D‰ÇYÀ~ãaÞ/óÑZ¼; ]R´@ð“Æ×8rÅ7è5ä>¤ð>ï|™¿?LïI¸ûÊe,>r÷=x0£FWi¤tZ¾ì£`F„õ—Dÿó!åGKsÈ%~¿×z_“'÷ µ!¶}Ìú?ýé îºëóvŸã£8òH³ù.Ÿ«ã÷¦O¦aЇ@½†.ʹ35¿y i3ëb¦ p~zZ;Z¿~ºÿþx-# ÇŽu¹õÖjÎ<ób¤œúT¹Ù* žÀu¾y6|y%Ê/èTt9 ’åÀ¤Æ—X¾ú D¨ Y‚²LË@9*@(Èü$ÉÀCðVߌÝëAn¿õCêë=„#¥Íü éÁBݬlÐ @™çª´E‹ê[nqÒ¤ZK¶Ù¾hQûûÿLžlÖ-ŸK¤žÞº±÷ÞÕÆ9K`S;ëÀm-`'>Æ1›9率۶ÿ¨;`–“½†ß*pÆåœzj¸ {«€û % øsžë0t¹ `Fô8Š‰ýƒLU«ŽB~`0AöCb-J=<\ '}m'ÿÇHfÏ Ä4· ( ¹/ äJÿ|&¡` D"ÏLJFŽ,gÙ²m}EãG?ZB2ÙÞØ’äÚkÇh&|> G=§x¸{w\›V×÷õ¹…%Oñ÷‘»ôߙݶmAd30h.¹ýFV¬Hsà ¬\ypqž{X&a´1äGí¸Év£»Pó2ÝS}8“߉Œ;ˆxR¹¾H`Ì%PêœõÔþ.ÌÉgâ¢+'0jd×¾ñg~AÐú¥µ½ÄXöƒÒ ï K!­m$· W³£–n¾ûkS´÷L·#HÙZlãGÌQŸ­·ýù{¬‰o~³?ð(0A»?ó¾Oî_ìÓŽm7ºRgòBX¼XÆ›î¢gÍAP6Dš–éœZ¼4ÿù&P¸L…Øl7^Ïs7}Nm¿{ìÑ!œ–™asÍ:ÝlD;ækÛ¶Ý쎬qß‹­>f½õgƒ¥ óùéD´™ÄhyôëAkâ‚^F!¢{a6¨NÙmÿÛƒ…Xµj ï¾[ Ì uØÍ?ç( ×öç5ŸÝÕöFw Ø€äÙ̘Ícº#‘þÒà‹g)Èk{‡Ã:'ÆC׬àÁ{?eô˜Œ­úadÛrý?×FölE²>¡)ôãm!YW\‚dÞCÙmä(”æïëäòE{[…€M˜¢•ToŒ|zƒ¬ T«@‚ÇûXì¨O’™@XÀæÌÜUðÖ¶º—Èâ!`Üæÿc÷ûC¤/R¸êòCNþßãéÿ[õ¥÷ÓàËU1î¹bO?õ#†ÖP[% á8ê%P&\†7µ_6ïʾÊw_> =´4™ümÓü' o{ݬº7óèu· sßæ¶4„xÿý/Y¼¸7p€‘G¯ßÀu1à `sáûÚvtWð )úlþh¦¦bU EÆ¢×_ÉkTKAÕ ëXýIûÃÇüñÖ©!BZ zÔFˆF£-Ê/ lû&ºªæ/$léXÎ÷¡ïÒê6ÂA0ñ-_1–€©¡…‘n¶ëëûº 2¯a³<¤„ÂpØá™g‹ÔÔ7,¬…OÖ¯ÞÚvDwOo6¿Í^ñEô¯ž‚($@ˆÖ69‚ ŽúÉ‘Àé«Móä¼UÜ{×2>ya+/«§gÏ(½ú–㈲–R”«`Óù´½¾_¨é±«-Å“L6A`#¬.‚H§ïëÖÄö¶2‚Ê6ëdÛν¶ ;6ÌË/odéÒ1À”€ú†$Dx Ê‡t{fqiº»`ÈYQÿ('W1ªñevõÖ"{} A D&6`¨²ï€?[Ö^À,Hí-yoà&ž» óùœnYÁë¯É–-IªkÃÔÕÕ’;í—_˜IŒm%]W"¾Y¯ {6‰¤eMQHèyœ€Y{«B¦@¤ AB…üžè­`{·ÿ6 B5Ýê[°Ý=z¸{l/úõ sÉ%©«S]p…Pr̯ÿæ‡-Xç¯m¶õ0›ßaÈϯ¯³.ËÍ7oå By¯Aõú pÑSÀi@ûçs/;«8¸Ü­a¯áÿ‡ã GÊZD2 ) i‘%¿.‚tOü@ˆû v4$ÜÓãNåÔ‚YçÍ{%~Ìý¿ÿ ¯.~…½'”3í=¹äÂ~ÔÕB8ÜÖ?´Êô#´îÜ£¯uòç³0ÒK–¤™0a R¾ìP·§o€·&ÑÁéö1€¨•Â ÚZ rß)¡O‡×_O³tiàëƹ>ê$Å-qK4ã½Y¼“5Æ«B@\"†MPEYQ`€YÏÖ]¿?ê4§Oê>g`f†þ>ÏyNwUuuõ9ý}ß·Þz« )A„%„l%ÜÓ^"äN }+@Âùeç%@™mò—ÿM§ÍK…ZPo„ ó_­ã¿gí%!à”/¨ÅGŠ®ú=½ü…®ó Ì­ÓiO¯^’'ŸÜ üùŽR‰z?7@rv3Ólx¹i;$«ŸÔ/à»Ûo¡fóYˆú§ ô1²¢‹ÚÔ¹Lª†å™~\† !p–(s„Äáñ#jX·±ííœÔó§Ÿ|šâ™›·rÆ”µÔÔ¤÷…y7«þœcý<„ÙÓò86×/¥äÔSctë–L{†:×b—Ðʯ×áöîn Êcv#ý㫹aû­,Ù<ñé•`/EVTAyL‘¼”\⛎owY÷ú…j‰ÌìGŸHÛ?‡ì…í¹ë JÔï|)°()ÙùrO_ÏîšBˆB ÐX¾}øÒ¯aÖdßš“'7Ë}î5MBugZy‘¶½ Hk …ÚŸéA»iàô=3¸tÏ ®Šö#]y&á^?F+„´C/Ÿ¯iÞ˜É ÔŠûkϵö`¢Wý:MôgôzîÇša÷9InÝVW¯ŠsÖyxñù¡ôìÕZçŽ)À.µ2î§ ‘]H·œ4§Œ©• á°äŒ3xúi?@&&€{›ý ?WWC¹&µ•³jžâ–š§X6ŽÎ•SèZ5 Be K!Üi „I@® @K3õÛ*¼Ú¬ç듦Ý~pÓ,ú<ØŽ醪i€Eïí»ŸÉqÒîz«¯]þ!úÝúöuèÎ<÷•&x ·†‘»Dœ[èKÎIÂaÁ¤I%Àfà3 —ǽo®.ÑöÊnQr«®MBÐÉ€¯Õåãèꨪ/g'y ù½Õ5d+ÂëÙtͯôÁ2½‚Ë;]α3°Ì‘Ù¢5»è÷è£LÙ°Q†|Þ[‡j[PÓnNþfþú䧠SZ7ÕfMï ÷y=¡­•ñlÙ’dêÔÁ¼÷ÞSÀX§yøê‡` özÞE @Äè,“ N@uõ´Yœ8”@· øÞÙÐýr`Z†©&k@¢z8ïÞx Sy€k¯²¸å–~™í¼¼lwWš'L6à@Õ»}{šK/…… Ÿ@¹2MHI(n5ž @»ÀX`µZîÕp×p`&Èž&!0ôä“#¾Ð9/¼È…_žÆºuÃ2¤Äç:Üv[¸‰îœ»€_d 8@JøÙÏvpóÍNX°þÎyŒÌú×­‚Ãm @;Åjõµ!÷Ö@ô_°ô$Ÿ£&xîÓ±þÞqR?Îú%N;íL®¿þÀ44Xì(ºÇßm=èy†Z¥š%X]Ö¢¦¦êeóÀw|y@@€v;µ}Â&ø×Ù ¶‚’ÿ] Ï^ "×KðÐC0sf-ï¼ÓÐÌà Ø#Ù[8M4(F×®ïâ¿öǽ Fš[ОqÒ»ðëoTueó+ó„üî ά }¤”Œ;Ž‹/¾˜Ûoÿµc”îÍ×ûé^ã n§¡W<+4Ž8"ÌGˆKCÓSöЮ …îzcÏînþïd"ºÑîhü»ïþ 4Q[›, h®Öw¯‘P÷ºµ@[ Ð^ÑXsî¹ç^¸pöŸäÀIG#—,œðÕ<þÚÀ½axè§}É7·½´¾id/ëÀÔç÷³T-à(Ô–2^BCüÒ§²B ´7T§BléyçžÛÿ™gž‘%%¥BJ‰è†Å3à;ÿ=öQèÛÀˆá¥œw^7¤ÔwmpPŒæw_çþ˜ºúrà¹Ø¾Ýâ¹çÊ2ãÜß ¡WØ*´¦ egžtê/œzî9ü×µ—ÊÒÒ ùÝÁ=ü 9i âÖï±xËÇüXñ—A@ÚàüÓçì{ü˜Î] ˜›žJYÔÖŽDíè…9ìí>ÐÖ0µü÷Àé(/Xøߤtv¯É×_œxü$ô«RûèäϬ (.;ŸMe .ýúÕ\]˜ Ê‹ØÀ¤…ݦ¸iñMÛ ävjkmV¬¨ºúü;ñ>p¨pP/`¨„ €NS l,ÄAä(-EQ§ ’ð¨£)ŸvžDdUw¡3‚ !xlù{ˆ‘5Ü|Ë8@z ý¹ÉïeλËé¢9yî4ÝBpÒTý¶-Y¼8 üæ%üH{Ç5· %‘¿TnˆócÀE@'¢À@d)¬x&|n¶¿sW¼ · ŽìmTÈ΂ÀB^ye!3Ÿÿ ÏÍI·ê(¹{÷ù5ÛäÈs w¿ß½ ˆÉh’t.,ŽöhsQ 7…@Ø?T£–«­"³…m¨+S(å8$õÄø&‚.R@ä` Ø}€/‚ÝIñ”8ŠCU˜|nfgN⊠°i;Ù}? Gë§-xãe\wÝÅ<üpWƫȘþûJêµ’¯íM#¦¥Ã¥áØËÉ(3íTŸ :Ç™9ƒYv´ê<@ŒBmMÓˆ H)Ãe2E]¨_$J¹"Ç@x8XMù"Ø}–D¤S`Y`Û@Ø›1àÔÃ’cḕ.4§ÆÚ «VÃä Î'2çþÿy‰{z3Ïý­ §ŸÞ)Sˆ¼ÅÂ!ŸÔ¾Ãp˜~&?€—3PµsõêÛ¶uÁ,ÎoxŒü½Æ[0ˆ½cPZ=Zþ%ΰ“$CÝèÀ R9±“ÁŠCx<ˆîH „•ÎhJUƒÂ@]ŸYðö°CE€yKáÛ_ª²}ÄBðúkkxè¿ïãå—ÿļ—†qò¤>H™pi~“£Ïmò›~îo›ü.˜7ƒÇøítQî¹'œƒòoÛ$a¦€Ýo*S§õFpxa„Å Æn½õïÜûàwì&–,ê˘‘ƒ‰FC™>¿—Æv`"¿N\ÇѧoóíÕ÷×M˜|1wnœDâTÔߣùçËÀò¥¨Ì­Š@´„2é:†(ç"8 EôG(¢—O†Ø1`ÕCÅ· Ô‰DX¶Ò'6²3¤ù:Í–ÊÅf£½þ­áŽJÃü£Á C4Ù Eƒtæ¾ ÀOT…k€™Wõ!y%ô ˜óì¾4u`e¦øJMóëf½Éì·]çî²~ý{[;Öïåþv ¸ñÆFà|Cdžv9Ào[ h{è‰R¼¥(/»wãLQÎñR’Q†áT”žÑñ`7@ÙE¤ºÅVJ™îR@2V"ÛÏqc‰\’Cþ«|ÀpÛ9ç؆r)Æáã,K©Ó¿õŒ³¡TJ~…pÂ!8á¸ƞы¾¤¹ý„NŒV•im )Óû|¹„CÿZ;všLy]èÄ/$²NÊÿý߉rà¿Èïû;ø XµøÄÙâÀ¡Ã8”«† f¬ÆJNàR™¦ITÐ/TÅQˆƒÈIG@ÉDQ¤BØiEäD⻕‰ùš[÷_·øV3a²}·7£Þéjm‹ºÌÃoíB*lSrdM'î¿L+o_z‰„…-mžîjqÊÄÞ™ÖZd= væ§S”Ü!>÷·;}ȯGôéA=~ç>Ö¾¤W^i •zÈ•§CJxWÀò•]›µ‡Zh} F…¶6SP³ØBåçsŠL u§:2„„ÄN; ¡jˆ ;Š´ÓÛX644€•‰‡sÝÞ¯b‹Âq^‡Qb àm`C&o>Šôw«àÈÊ š,‹)}zÓ½$F(,8å»ÝI&-ª»E0ÔÙK'¹›èîN Of"¶W·ö#¿ŸÐKPdër<ÿóçÇyíµ2¤œêÑ.€¸€'$ðOHùíÚb@Ëa@‘= ãîÊ„aÕ4ÄÓ|ýÜAôïÕ ¤Mu÷•#X–EŸ~¥ˆãÊp“:•1“ô±†ùIu­îÀKkšúõ+(šK~ðtâ$þs;wÞ€2öLæ¿“öü&à9‡hq ù8 øʘ½µ³,D¤ôh¡ބʦ••™W!vXw2¶PDw\6 -°Ó¹Dw¨€Ë¤o5D27tÜ‹e¯Ü Të9@‚[n8ŠºÏ’Œ™XÅ´»P ‰ ÂaR B!½ÏEiD'0'—PB¸É¥›Ú¸¾Áük¸ nÒþ~?÷½L}y[;6iþ|åôý—,I0gNwà2¼)'€ŸìÖxjq ÂÜ.bÜ%Bêïít:”VT|"Gªˆ7ÛR^uKBÒÊzØÝz.óŠÝ»nþ÷±Õ´9(·z¦+³] b¿ A9„>Dç ˆ ÊËÃÜ~çxêêRŒüZ¾üô”) Âr»]‰ùÚ0Kt,:ôúÜÝÁç·í—N~“Ea²6Üí1µI?ÎÖ)„ ©I2cF=;v\Œðiøi+¿9hÕ8ãöåâÊ/ód¯»( TäN§ÀJ«þv:©¼í–æMw¿*Îkí~åýF§› ‡“Žæ¨AÙ'aàS ¡ÊT¬‰P¹5J:&黨Œ’½a¢±?¸y4õi íÄ©gõsUêJ=‘Òhÿ²›´ N “)ëؤYu‹ÀDP·æ×Í“À0ëuë禱¯õQ}Á‚q&Oî < œàº·»øðØZ`4ð€ˆqj—ïðJõD¬¤•Rv·›Jÿ6õZ[ 1²–´ãmO‹P+J½ƒ"¾€ž¥ôM–“êªé’Ž!{b7†¯¤©1Í9ÓúAÈ©4;è%Û‡\¢éðëÿº¿½ýúúnâa(£“9m¨ß¯îsÓÇì^–B®e²}»ÍÙgïeõêÛ€çäåâs ½ˆ@.5h5]3ºG†óTÅt"MaEþ´‹üº¯ºEÉnr¼Å¨þø+ÀÇ™ô(œ?¢?õÉgêKßþåH$ƒ‡VЫo©¤ÅØ Uˆ°ó7çz¤lÔ4º:6¥å~»ÓMy&Ú‹,^äÓë6ýÒα;Ù˳oJ3õáõvCþ\kD Ð÷ÜÓÈêÕ'¢Æý!ŸüN{¿/@¼~°ÉojQèÊUg¤ì‹L§³šßÑ1^ƒ>ÍB„ìعCôð?(ûF`.Šü¥ðÝKG°·>ÉÅ“2l@g¤ áôî[†•–tëY¢œp€N:g(*ÿe×á¥ÁMÄwûÕëGôb´/®4Á1ðŽÞÓŸÅO@¹ïU,ù³m–R <ÿ|’¯}m/ÉäBÔÂFºöwÎWI˜"`û Zqý/@CxK+gqœ]LI¥ù3¿ÒŽK{.°õ—Ï TwÜ6ºº#†wæÂi)+‹ D¢)!ˆþòeΊ"ºŸfô+«×çW·©œ_š[“ë×›Ì~)ò½*^ÚÙ]—©^>ç:ýZ'ÏÝfö¸e‹ÅqÇÕ°cÇíÀ]x£VÂ7¼0ø&#òGCÐÈÅ]‘pT¢R(òç@âîã$êïsLöŒUZöHJ@Æ ì™0¡íj¸ì¼iG0þè® œXÁ´PE~Ÿ7Û/LæüÙo~/tì¥å ÕoÒ¬z=ÞÔLLa¸Þ2\cªÛ‘¸^ÂËäÍ7Nx}25J±/âïg?ÛMMÍ$ùõ—ÆýcÌðú&àzù!Ytå{á[¸Í:‘êÿܧ½ÝöÀ”ù¾# rC”.Û¢X%’#V”S¶'B(,¸î¦Q$‰¸Å××&Vê¬ï~±¬L<{>Íýq/òÊo.Ñ‹­»˜o“Vö"¾ÞÉÒ­KËӯѵ¾—pÑï©›ø~¾Šl—ÄéóÜwß^~¸¸?S¯—‘½[¨õ>ê¥Û•Ö8ø€ÂD¾Å¬GÍü« ÌóÊÞ míe•Òߪ )lŽNUÓÝV;ÍŽ?®+C&UoJsÚ½ˆÄož{lÚq¼å©¸xv¯4Ý46i:¿ú½ˆcºÎ¯¯óB‚_{²ºY®ß97Y îßÉ}SÎkÂ˪ÈõG8ÿÝ›o&øýï“(bŸ¤Ý×õBÂÿ xi9DŸ„x«®úã‡@Àp*ø]èɯ‘¼Š CT2®w5M©4“ìÃàc*±¥¤ÿÀNôì]B*e3lT%‘¨ŠpËju5DÊ&ènN^º?ñõt¿4=¿5¬Bå‹?D§Cªpק×ëŽôs 7tƒîl4 SÙ\¡+¥`ùò$_ýjÛ¶ý Þ‰ï ¸1<©ƒ2ëÏ j¾wÝØ®Mєҷ³8ïô”•„¨¨ŒPÞ)„m>Ú«w*IDATK:WňDB˜´Bþ˜y±D.–Äúqs4³ŸQˆÐzz±í,ô\~íw—É[cÈpî&¢É:ÀîEp]ëëùæÕ÷QVVC<þmàW¾—éþñwà놇?¨8Ü-€çþùÏ »ž|r/iÛj"­2³šŒûÏ·ÒÊhï\']vºû£{¥MßÎýç~¡ö—èºCͯ|±÷4ØæXE¦<7Mïöè&»‰TîòúóèÏâçoðëZèõ©<)Cbòä=ÄãGºêð"ÿW$ü# ÜáñCTÎà©×_Ÿöå“Oî%¥´„š¼ây†A(`8v`‘ÿBêhŽv-6¿9V…—ù]¬ævÃï÷p¼ð&è&¾þ;é¿£S¯é¿ÐóÝmðþóêçëæ~îoâ^Œôœsv±`AWàuW£é/a‘PÛ}1xßPè ãpWÝÿÄ‹N9¥'R¦E>¹M &³° ðÊó²üˆ¸¿‚¡r7G«û•5Y~7Ó½¼ˆ]ˆô¦<¯{ó¿zÿÇBßúÖNæ΂ Ï€¿æ_%`š‰ßÐFȇ¡…8ûškFßqõÕ£ÊÁ–B¸—ÑЉ_lßQŸX¢ë^z¯~p±ÂK8÷ò«ß4cEðjƒ—9ï÷ûøÕç@×Úº6.–ô¦vxµI¿ÆDúìµÎŸ•+ÓLŸ^ËܹGáOþÝnPó,pm‡›°Ç™gö}ÿùçÏ®ª¬ŒH)íŒö7ßO#˜^*´4¯sØ?Gž_¯ûøµI¿Þgz‘ÝÇN¿ÞM6S}~‚Æëwò‚Þäô2^-]w0æÖíÿí·ÓLZÇgŸ}Õï‡ù7sÐ áb/½ üÄ>PQcm‡•ЫWÙ3Sý…„¤—°öËón£Cþ÷Þ³™4©–¦¦+QcýLä—¨~ÿ^zµȇm‰üpY¥¥áEË–M;i̘*)¥å"¿aÉ£3¼Éï…†¡¼»½ëà”ÕGtÌÑpÅÝT·ó¸ÃfM×éÏoêúJ“®úüê1]çU×±Ÿðõ"~þ½œI=N”ßWÔóÄ ÔÈÝ_]×èØ—.a®€sv¡Èÿ’¡ð!ÇábÜ÷«_xÒ˜1ÕRʤùMV€ßÇdÊ{i¥BÇ^ä5™ØÅju½Þ´Ož~^¦Øç𪻘g/&½¯À«žBÿMVðe'UÁêÕiî¼3ųφ•¨¥‹!ÿ,Óâ ~ ²M’ ‰ÿ÷ƒŒºéÊ+GK)ã"wáI7ùÝãÉÅt¼HâGR“íE =¯Ð–,Iq÷ݵ¼üò‰kkÈ®n‚›üð½4Ä¿ lÓèÈÀ€)SúþôºëF–@:3Üçß$¤–&=>x¤aÈ/z½^ãÝ…´c!òjc1ÇÅ_šž¿X2z]ãÜ¿Ð0gsÒÅ>s_A: W]µ‡… ->úèßýÉîÊæ¥/òß.à!âWô(ܦÐQ-€î'ŸÜcÁSOM7xp'²SH‚¹ø \eL¤)†ìz½®b<ì…|û£M›# iøæ´A‡‰èŶ×ë~zzþ«ž]ä~÷»8÷ßßÄôþ…Ú¿¥Ü÷zWž„Ó¼þÈËQ˽´ tD 4~|× ¯¿~ô¸Áƒ+¤”)!„®ñsçâ›ý¼ÈêõB›,“ùnºN¿^O×ÓLÇÅh×bïµ?V‚Ù½ÒŠµüê+$€EfÇàì¹m«kfÍJqà MlØÐ5‡ÿjòÍ}¯Ç~8YÀ¢‰¨u˜Û :šuï^rå9çôyô K)›\ä×·œ’çR;Æ•fzAÝ‚¡­nzáDCëy^íóúökK¡öCX/«ÉïšB÷.êšlÿljk-y¤‘çž«bÕª*à[À¨Åë|5~æàU·¦à­mšögûÑÈCŠŽ&¾vÝu#½í¶c¤m7d&ø˜ˆoZÈÛ4Ä‹@R+¯çã‘Vˆ|î´Böbúã¦û¹Gôë‹I+Ô–b‰Wúþ^“;ýÖÃw/رfÅ42{¶à™gz±gÏÉ(m"Ð[««ù›¤òôß |þð?í‘üб|§\qÅÇü C¥L<þú*þÒ•fâë¯Xw |{ü¸Ä ð":ï4ó;ök1u˜î]Lùâµ¾­ç~¥W­J±reœwÞ±˜76n<—ÆÆS3÷} QÁ)³øðè:à!à·E7² ¢£X§]{í°ßßqÇè¡—BX"_Ó{i}ئá@SÞä (DÐBÇ…¬‡æ·ê'< ]Sl~1 ¸ü,Ñ(Ò !˜5+I}}#¯¾*Y¶ öì)c×®/R[ëþH µ £S¿ŸÆ×Ë<-áFÛ·‹ <@›GG± .èûÍk®2´Gˆkz¯›øŽ–÷ÛÃG'·)¯mïþÆ^Œ-Dt¿:ýÊku˜Ò ‘¸˜ú µÑ•“Gt!`íÚ4/¾'‘Ìœ)yï=ˆF¡© ¤¼T*†mOÆ ˆ#÷Uo.ñk$œ*`ƒ€Ä-À½ÊQxHòmQ´wP:p`ù/¹¤ß·ÇŽ­Ìxüuò›º΋gÚÒÏæÞôâ3”ÕÜá®b´z!nºÆïžz™b„“ƒ,ÁÜŽ8=߶%–¥HoY꼬 |ÐfÇH¥`æLØ´I¢Hw"p.PLû´×Dò¢ˆ/a—€‡$üBBÓ2Ôæ~´òC;;GþóƇO¿ì²Á™0_]뛜Òp¬ B>ùýˆåGL¯kõóý%ºû¸9DßÓÝèY²™È.„ •²Ù½[ý®É$lßž&“¬ZUÆüù•$“‚—_îÌŽ¥¨ýÉ¿tC½¦SPcó&ìѽêÀ k…²òß\ ܃ھ¥Ã¡= €)ßüfÿ›®½v8Ùá>‡ÄirIî7ôgÚ¿W@¡‹éx¥“î¾—Wžéz¿²Ím› ^Z=›.Dˆõë›H¥$MM6Ë–Y””ÀæÍYºt–%ؽ»œåËÇ¡¦ÇŽG™ÕÇ•>Ït D÷ªÓ1õç x\ÀËo/@ìaH¶«±ýæ ½Ž|ý‡?öð<¼k§NBf7è6i~/ò{õóÑŽuáÅÝO08çê¥×¯+VÐøÕÅ™ï‚E‹jil”$“’Å‹á㡤/>d²„¦¦ÎlÚtjã‹(G\5æÞ\Ó½%‘s ¿jÖ7ßÐ|°7´r#9Ú£(ûÊWú¼ûÄŽìÔ)”™ÛïÞ³×Mt=ÊÏd˜´¾ihÐ “…àÎó:÷Óè^å½ò ¿6éð6ÝBüãµìÞm“JÁܹ°~½r¼mÛv–U‰mǨ©™‚mCiõ#Èî|ZíÓ®ƒù ê÷ûPª;Þ>ùš®C­î¹í 6ꢽ €ÊÊž}íµÏ4¨4³T·>¾o ÷uºzºIëûøxõ監õ½ÊÊ?¢î£;ùëÖ¥˜=;I"3gZ¼óŽ"z2y%Ð )£XÖ4¤‡r„Å\÷p¶;6µëP¾jîû×Iµ2ïmÀ'@j!Ø?Þv!i١О|ÇwzìÉ'ÇŸ5hP©+ÆßdÖ»5½¾©·iü¿×ß‹ø¦|<Êy¥¹ïïU¿Ž\2¹°È]7@ż'“væØ&—D£°bÌž²`Û6ÁßþFúà<±Ï“4®b%Q^øbp0Èo2i i¡,’yÀ³)økX‹š°sKnyÝšëøhOàüéÓ‡œ?qb¤Lh“ɯûüLÓ8¿Ÿ¦/føÎVL$  î±jUF‘=·¼šÊj³cG)Á¶aÇŽ‰„dݺr,¨"±kW”yóz£1˜ŒÒؽ2Ç&xiﶢÑ `G†ðÛ€×|X%€ Àk~¬U¹ÁmíBÄb¡+¦OüÛK/íU‘~ÎÜ~“HSÜ|¯¨>Q½´¼&¡`rðáÊóJ—F¢ƒÒôëÖ5KÒiÉúõ6»vÁÖ­X¾|$–&™ ³lÙ0’É®¨ùìÇ¢ÌóÎÀ1÷mkD÷ë6 K„Êß ¬J„âø†H¯îÖ¯¡ös~E]{Èöál“h>€ž&T~ºbÅĤ] zêÞÒÒLæ¾ilßïãF1}S¿ZGnZ®ùŽ«Á¢EuìÝ+I§á­·`Ó&åa_¹ò4‰ ,+‡žH:=è B=Œò°›äû¡î›`l“TÚü­Lþ§À‹¨®‰¶¼¨ö~ ëæ¹2¶Û ²ÒŸ¬'h¯hë@Ñ£;-š7ï¨$3ëøëD×ûù¦a>}¬ßÝÿ×Ï4÷·ß±;ÍÛBÈ'º‚‚mÛ’Ì›—À¶aëVxüq(/‡;.$®FÊ(µµ_IJF£ÌÛž(’ ñÃùïk“9úîÐÀÓÊj)­Š¿O¥¬O ù²º0õ|úPš©d{æâÐ_g:?)@Úš*p£Ï˜1åo,]zìв2\šßmâ[ø“ßäƒÇ·ÓOÇ•æ~a 9‡Ý}tóϺv­Å¬Y)’IɬYË—C$RŽÆ¶/@õÇûcÛßE=亿ûØtï¶ôWz¶GƒBÅÔÏ`)[ ý(jüÐ$©´ Ú²ðý»îÔ¿¤D¶"Enßd øEþ™¼ù&­ïö ¨t³öVöx\îs¼Õ×ÛD£°zu˜Ù³#¤R°s§à/‰¡Õx”‡½˜ &e )—d‡×ŠÁA šÑ2ÒBƒzÆFw—¦a~âž‹Ãö4PüuA0Øéá'éÁömmQDºwLÿùχN¿è¢jVæ%sß±¼Vû1‘òIONž{8wž‚íÛ•æN§aƱlØPÎÂ…=H&CÔÕE˜;w JsÎDý¼]³<µ­9ÞÀÛÃÞ$²Vw=ð°1K>‡€uðú'(éµa“@9àÒhÚ¢8ýßèy÷å—÷@9ýÒZ¿ßmò›ûÔ‡ö ×p¥åöõÕTÓ&êë%¶ kÖÀ¶mPZ ó棡¡œx¼„åËOE)±~ÀÔÏXNûñ°ƒü_™Ðê”.&`W=lZ§Ê|¶–-E™2›€Õ™Ê>6„Æh!´50ê‚ ª;}z?ùSò{ ÿåù)®Gô)¢¿õV;v(¢ÿóŸðþûÊþví©Äã]±í0Ÿ|r2©ÔP”VzߣÀ@æ·7¢ÏÌ8ÞšP£eÛ€°€ís@ÚаÖ=r¼íDyèP ö€¶ä9yÆ]Þš3gtUY™mÐün@®é¯B‚ÝŽ¾¬vá…z¶l±‘^zIEÀÅb°gÏ4Òé>H¢¡á,k<Šè]ÉzØ;Ñ·Ò2Šä¨Y­QÏ•|ddìú¤6¡$ÜÎ̵)Ó½C£-Y?¿÷ÞUeeÒE~'†?‰"zšÜ}•0B²vmŠçŸO’JÁ®]6¿üe*³¹ãå¨ñq m=†¬×ßæxØÛªFÿ…€:ÔˆÁ*ÔÞõB <ìM@ÈgQ3ú°G€ÃmB•–Š§.<ê’O,Ë8üÒØvŠ††4R¦Ò¢±1‰eY¬_³g  µ¨ÄìÙ>ûL¢B[Ï#;ûìëwk7Ú[BJdp eyGwÒ0¿Q]óA æÔ¡œ’•k€…£õÚ/¹ „xà—¿xIß¾67î[·6P[çãKxíµ*‰(é4¼öZ7êêÊPÚüt”£9†ZìÑ´€D{ëoÙ ¦-@£€ã°<³Å'õ°p#ʱX”©ì#àíƒÐø‡ZNíуÇ™ØWP)-Kˆ÷Þ;’¦¦ž¨åŸÆ£4^‹F6¡­iu¿þø¢Œãm/JAGQ ûÝ%jE¼DþùX5¨ùªk2×îB™î´kBÃú>câÂJRƒ$²D("ôÁ;¦=}fÆñG} Jíš v;aý_Q=Œš¢ê˜Ûúç]@&þNé*‘£$!)\µÚšùîgº?.Tß<ÌÖé?*ï:MP7 ï£~ïZ²CM¥ùxàÐ0JT.¡Û’ãI”XRì ôsb|Z~š[ŠÜ!‰âí s¤ l{NÂûNÆÏQö|ܘéÚ …ðsº/>žðH‰”)²Û¯‡ha৹SÍ ªO¾ Úº& êÔµ§`ænTGýmÔ²2Ià`GK¶4@€Cƒ,BWPùÃë‰Rš?”YÓÁ!~ÕÞ¯5¼bØã>ÌÜ 5>°-+·¨5àv6Âü5¨þøzÔñü¾lZ @{ÀÁ¢Ë%¢júoeåt°2Û·êäwâs|-?­þfÆñ–Bñv»€ÆFødØ4ÔÂây¨ÐÖm(²Û(S 0Ýv8X`ˆ(ÿÒ=¢ò;Q)ÈN®uÈ.\ÇN·[dºãypbØk3mf¡–„Ú;¬ Ø<›Qjÿs²!…é @à Ø#TvÊ«á^O¶¨ø3¡Ï5Û×=½ßBb=!TXº@M:û#Jy[D­ó{=Ô>™Éh$+BCiø¢µ-€H¨ôØ_Äú<5šð@i§m!m[)q@±= r…Mb¶mƒ½Eb=å,ñ ”Æv$À ãêO õ­ü,t8´¦ˆ@øÚPéÑ— ØñwÉ i_݃LKì&›¦ç÷ ÷¦Qž¹ÌÚolEyÛÐÊhM0 äMȦeM›F¬$»xÄb”‘GųK?pˆÐš>€cQN·&{€ @€mÿ?}—žp¯6-IEND®B`‚gprolog-1.4.5/README0000644000175000017500000001437413021324543012210 0ustar spaspa GNU PROLOG ========== by Daniel Diaz Daniel.Diaz@univ-paris1.fr INTRODUCTION ************ GNU Prolog is a native Prolog compiler with constraint solving over finite domains (FD) developed by Daniel Diaz (http://cri-dist.univ-paris1.fr/diaz/) Last information can be found at http://www.gnu.org/software/prolog or better at http://www.gprolog.org. A lot of work has been devoted to the ISO compatibility. GNU Prolog is very close to the ISO standard. Here are some features of GNU Prolog: Prolog system: - conforms to the ISO standard for Prolog (integer/floating arithmetic, streams, dynamic code, exceptions). - clause indexing. - a lot of extensions: global variables, definite clause grammars (DCG), sockets interface, operating system interface,... - more than 300 Prolog built-in predicates. - Prolog debugger and a low-level WAM debugger. - line editing facility under the interactive interpreter with completion on atoms. - powerful bidirectional interface between Prolog and C. Compiler: - native-code compiler producing stand alone executables. - simple command-line compiler accepting a wide variety of files: Prolog files, C files, WAM files,... - direct generation of assembly code 15 times faster than wamcc + gcc. - most of unused built-in predicates are not linked (to reduce the size of the executables). - compiled predicates (native-code) as fast as wamcc on average. - consulted predicates (byte-code) 5 times faster than wamcc. Constraint solver: - FD variables well integrated into the Prolog environment (full compatibility with Prolog variables and - integers). No need for explicit FD declarations. - very efficient FD solver (comparable to commercial solvers). - high-level constraints can be described in terms of simple primitives. - a lot of predefined constraints: arithmetic constraints, boolean constraints, symbolic constraints, reified constraints,... - several predefined enumeration heuristics. - the user can define his own new constraints. - more than 50 FD built-in constraints/predicates. PORTS ***** GNU Prolog is currently ported to the following architectures: - ix86 / GNU/Linux - ix86 / Win32 using Cygwin (see file src/WINDOWS) - ix86 / Win32 using MinGW (see file src/WINDOWS) - ix86 / Win32 using MSVC++ (see file src/WINDOWS) - ix86 / SCO - ix86 / Solaris - ix86 / FreeBSD - ix86 / OpenBSD - ix86 / NetBSD - ix86 / Darwin (Mac OS X) - x86_64 / GNU/Linux - x86_64 / Solaris - x86_64 / Win64 using MinGW64 (see file src/WINDOWS64) - x86_64 / Win64 using MSVC++ (see file src/WINDOWS64) - x86_64 / Darwin (Mac OS X) - PowerPC / GNU/Linux - PowerPC / Darwin (Mac OS X) - PowerPC / NetBSD - sparc / SunOS (4.1.3 or higher) - sparc / Solaris - sparc / NetBSD - sparc64 / OpenBSD - alpha / GNU/Linux - alpha / OSF1 - mips / irix INSTALLATION ************ Please refer to the INSTALL file (in the same directory) USING GNU PROLOG **************** Be sure that adequate environment variables are set (see INSTALL) You can then invoke the top-level using: gprolog and the compiler using: gplc FILE The simpliest way to compile a Prolog file 'prog.pl' is then: gplc prog.pl which will produce the executable called prog (use gplc --help to have a brief overview of available options). Refer to the documentation for more information (see below). WINDOWS ******* In Microsoft Windows if you intend to use the gplc compiler as described in the documentation you need to ascertain the following conditions are met: - for the port compiled with MS Visual C++ (tested with version 6.0 and Visual C++ 2005 Express Edition) you'll need to have MinGW as.exe (renamed as mingw-as.exe) installed and the cl.exe compiler (used mainly as linker by GNU Prolog) available in your session path (alternatively link.exe is used). - for the ports compiled either with MinGW or Cygwin, the gcc toolchain must be installed and available in your session path. Observing these needs you'll also will be able to do the mixed language programming, as the examples included in the ExamplesC directory. However you'll need to write your own Makefile as the one provided is for gplc calling 'gcc' and the options passed by GNU Prolog will not work (see file ExamplesC/README). DOCUMENTATION ************* The directory doc contains various versions of the manual. Refer to the file doc/README for more information. An in-line HTML version can be accessed from the GNU Prolog web page. WEB *** The GNU Prolog web site is: http://www.gnu.org/software/prolog/ or also (primary web site): http://www.gprolog.org/ MAILING LIST ************ To communicate with other GNU Prolog users and/or implementors send a mail to users-prolog@gnu.org. To (un)subscribe to this mailing list send a mail to users-prolog-request@gnu.org with (un)subscribe in the subject line. BUGS **** Please report bugs to bug-prolog@gnu.org. To (un)subscribe to this mailing list send a mail to bug-prolog-request@gnu.org with (un)subscribe in the subject line. COPYING ******* GNU Prolog is free software. Since version 1.4.0, GNU Prolog distributed under a dual license: LGPL or GPL. So, you can redistribute it and/or modify it under the terms of either: * the GNU Lesser General Public License (LGPL) as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. or * the GNU General Public License (GPL) as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. or both in parallel (as here). GNU Prolog 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 copies of the GNU General Public License and the GNU Lesser General Public License along with this program. If not, see http://www.gnu.org/licenses/. Remark: versions of GNU Prolog prior to 1.4.0 were entirely released under the GNU General Public License (GPL). gprolog-1.4.5/doc/0000755000175000017500000000000013021361015012057 5ustar spaspagprolog-1.4.5/doc/gprolog.tex0000644000175000017500000000007213021324543014256 0ustar spaspa\input{packages.tex} \input{macros.tex} \input{body.tex} gprolog-1.4.5/doc/references.tex0000644000175000017500000000403213021324543014726 0ustar spaspa\newpage %BEGIN LATEX \addcontentsline{toc}{section}{\numberline{}References} %END LATEX \begin{thebibliography}{99} \bibitem{Ait-Kaci91} H. A\"{\i}t-Kaci. \newblock ``Warren's Abstract Machine, A Tutorial Reconstruction''. \\ \newblock Logic Programming Series, MIT Press, 1991. \\ \newblock \OneUrl{http://web.archive.org/web/20071225092145/www.vanx.org/archive/wam/wam.html} \bibitem{Clock} W.F. Clocksin and C.S. Mellish. \newblock Programming in Prolog, Springer-Verlag, 1981. \bibitem{wamcc} P. Codognet and D. Diaz. \newblock ``{\tt wamcc}: Compiling Prolog to C''.\\ \newblock In {\em 12th International Conference on Logic Programming}, Tokyo, Japan, MIT Press, 1995. \\ \newblock \OneUrl{http://cri-dist.univ-paris1.fr/diaz/publications/WAMCC/iclp95.pdf} \bibitem{long-clp-fd} P. Codognet and D. Diaz. \newblock ``Compiling Constraint in {\tt clp(FD)}''. \\ \newblock {\em Journal of Logic Programming}, Vol. 27, No. 3, June 1996. \\ \newblock \OneUrl{http://cri-dist.univ-paris1.fr/diaz/publications/CLP-FD/jlp96.pdf} \bibitem{gnu-prolog} D. Diaz and P. Codognet. \newblock ``Design and Implementation of the GNU Prolog System''. \\ \newblock {\em Journal of Functional and Logic Programming}, Vol. 2001, No. 6, October 2001. \\ \newblock \OneUrl{http://cri-dist.univ-paris1.fr/diaz/publications/GNU-PROLOG/jflp01.pdf} \bibitem{iso-part1} \newblock Information technology - Programming languages - Prolog - Part 1: General Core. \\ \newblock ISO/IEC 13211-1, 1995. %\newblock \OneUrl{http://www.logic-programming.org/prolog\_std.html} \bibitem{Jaffar-Lassez87} J. Jaffar and J-L. Lassez. \newblock ``Constraint Logic Programming''. \\ \newblock In {\em Principles Of Programming Languages}, Munich, Germany, January 1987. \bibitem{pvh89} P. Van Hentenryck. \newblock ``Constraint Satisfaction in Logic Programming''. \\ \newblock Logic Programming Series, The MIT Press, 1989. \bibitem{Warren83} D. H. D. Warren. \newblock ``An Abstract Prolog Instruction Set''. \\ \newblock Technical Report 309, SRI International, Oct. 1983. \end{thebibliography} gprolog-1.4.5/doc/compil-scheme.pdf0000644000175000017500000006675513021352245015327 0ustar spaspa%PDF-1.4 1 0 obj << /Pages 2 0 R /Type /Catalog >> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 3 0 obj << /Type /Page /Parent 2 0 R /Resources << /XObject << /Im0 8 0 R >> /ProcSet 6 0 R >> /MediaBox [0 0 394 499] /CropBox [0 0 394 499] /Contents 4 0 R /Thumb 11 0 R >> endobj 4 0 obj << /Length 5 0 R >> stream q 394 0 0 499 0 0 cm /Im0 Do Q endstream endobj 5 0 obj 31 endobj 6 0 obj [ /PDF /Text /ImageC ] endobj 7 0 obj << >> endobj 8 0 obj << /Type /XObject /Subtype /Image /Name /Im0 /Filter [ /RunLengthDecode ] /Width 394 /Height 499 /ColorSpace 10 0 R /BitsPerComponent 8 /SMask 15 0 R /Length 9 0 R >> stream «ÿ΂ÿ‚ÿ¨ÿ΂ÿ‚ÿÔÿýõÿæÿÑÿ‚ÿ‚ÿÔÿûøÿæÿÑÿ‚ÿ‚ÿÓÿÿ÷ÿæÿÑÿ‚ÿ‚ÿÓÿÿ÷ÿÿÿüÿýñÿÑÿ‚ÿ‚ÿÓÿú ÿÿÿÿÿÿýÿñÿÑÿ‚ÿ‚ÿÓÿþÿÿÿÿÿÿÿÿÿûñÿÑÿ‚ÿ‚ÿÓÿþÿÿÿÿÿÿÿÿÿÿþðÿÑÿ‚ÿ‚ÿÔÿýÿÿùÿôñÿÑÿ‚ÿ‚ÿ½ÿüñÿÑÿ‚ÿ‚ÿ½ÿüñÿÑÿ‚ÿ‚ÿ¼ÿþðÿÑÿ‚ÿ‚ÿ¨ÿÑÿ‚ÿ‚ÿ¨ÿÛÿùÿ‚ÿ‚ÿ¨ÿßÿöþÿ‚ÿ‚ÿÈÿÿÿÿèÿáÿýúÿú‚ÿ‚ÿÉÿüÿèÿãÿýõÿý‚ÿ‚ÿÉÿûÿèÿäÿþ‚ÿ‚ÿ¸ÿûÿÿÿùñÿæÿþ‚ÿ‚ÿµÿþÿÿÿÿûÿñÿèÿþ‚ÿ‚ÿ³ÿþÿÿÿÿÿÿýñÿêÿþ‚ÿ‚ÿ²ÿþÿ ÿÿÿÿÿÿñÿýîÿþ‚ÿ‚ÿ±ÿþÿóïÿüóÿü‚ÿ‚ÿŠÿüøÿýÿ‚ÿ‚ÿ‡ÿôþÿ‚ÿ‚ÿƒÿûûÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿøÿü‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿ÷ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ¡ÿ¦‚ÿ‚ÿÐÿØÿÓÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿàÿþýÿýÔÿ‚ÿ‚ÿÐÿàÿþþÿûÕÿ‚ÿ‚ÿÐÿçÿûÿÿþÿÿÿüÿþÿöèÿ‚ÿ‚ÿÐÿçÿûÿÿûÿ÷ÿöèÿ‚ÿ‚ÿÐÿçÿþÿÿýÿýÿûÿ÷ÿèÿ‚ÿ‚ÿÐÿçÿúÿþÿûÿüÿÿúÿèÿ‚ÿ‚ÿÐÿçÿõÿûÿüÿôéÿ‚ÿ‚ÿÐÿçÿçÿßÿ‚ÿ‚ÿÐÿçÿýÆÿ‚ÿ‚ÿÐÿçÿþÅÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¦‚ÿ‚ÿÐÿ¦‚ÿ‚ÿ¦ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿøÿü‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿ÷ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿÿ΂ÿ‚ÿ¨ÿ΂ÿ‚ÿÓÿúÿþÿýÿþýÿþòÿÑÿ‚ÿ‚ÿÓÿþÿÿÿþÿþÿþþÿþñÿÑÿ‚ÿ‚ÿÒÿÿÿÿþÿþýÿþÿÿþñÿÑÿ‚ÿ‚ÿÒÿÿþÿþÿýþÿþÿýñÿÑÿ‚ÿ‚ÿÒÿùþÿÿþÿùñÿÑÿ‚ÿ‚ÿÑÿûþÿûÿÿÿþÿñÿÑÿ‚ÿ‚ÿÑÿþÿþÿþÿÿÿÿþÿñÿÑÿ‚ÿ‚ÿÐÿÿÿÿÿþÿÿûÿÿýòÿÑÿ‚ÿ‚ÿ¨ÿÑÿ‚ÿ‚ÿ¨ÿÑÿ‚ÿ‚ÿ¨ÿÑÿ‚ÿ‚ÿ¨ÿÑÿ‚ÿ‚ÿ¨ÿÛÿùÿ‚ÿ‚ÿ¨ÿßÿöþÿ‚ÿ‚ÿÈÿÿÿÿèÿáÿýúÿú‚ÿ‚ÿÉÿüÿèÿãÿýõÿý‚ÿ‚ÿÉÿûÿèÿäÿþ‚ÿ‚ÿ¸ÿûÿÿÿùñÿæÿþ‚ÿ‚ÿµÿþÿÿÿÿûÿñÿèÿþ‚ÿ‚ÿ³ÿþÿÿÿÿÿÿýñÿêÿþ‚ÿ‚ÿ²ÿþÿ ÿÿÿÿÿÿñÿýîÿþ‚ÿ‚ÿ±ÿþÿóïÿüóÿü‚ÿ‚ÿŠÿüøÿýÿ‚ÿ‚ÿ‡ÿôþÿ‚ÿ‚ÿƒÿûûÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿøÿü‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿ÷ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ¡ÿ¦‚ÿ‚ÿÐÿØÿÓÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿÔÿýÙÿ‚ÿ‚ÿÐÿÕÿûÚÿ‚ÿ‚ÿÐÿéÿþÿþÿöÿÿÿùÿÿýæÿ‚ÿ‚ÿÐÿéÿúÿöýÿøÿÿüçÿ‚ÿ‚ÿÐÿéÿûÿ÷ÿÿÿýÿýÿÿûçÿ‚ÿ‚ÿÐÿèÿüÿÿúÿÿ÷ÿÿÿþçÿ‚ÿ‚ÿÐÿèÿüÿàèÿ‚ÿ‚ÿÐÿàÿèÿäÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¦‚ÿ‚ÿÐÿ¦‚ÿ‚ÿ¦ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿøÿü‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿ÷ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿÿΊÿΚÿùÿâÿýÿëÿΊÿΛÿúÿâÿþÿëÿÑÿŠÿÐÿíÿ÷Úÿ·ÿýÿëÿÑÿŠÿÐÿíÿôéÿ÷ÿúÿñÿ÷ÿüÿýÿýÿùÿõÿüÿÿûòÿÑÿŠÿÐÿìÿ ÿÿÿÿÿþëÿïÿðÿÿÿÿÿÿÿÿýÿÿÿÿþÿÿûÿÿÿÿÿÿÿýñÿÑÿŠÿÐÿìÿÿÿþÿþÿøÿíÿÿùñÿÿÿÿÿÿÿÿÿþÿþÿùÿþÿÿÿÿÿÿÿÿÿýñÿÑÿŠÿÐÿìÿüÿþÿþÿÿþÿÿÿýÿþÿÿÿÿÿÿÿÿýðÿÿÿÿÿÿÿÿýÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿþðÿÑÿŠÿÐÿìÿÿÿÿþÿþÿ ÿÿÿÿÿÿùÿþÿþÿÿÿÿýñÿíþÿôÿìÿÿðÿÑÿŠÿÐÿìÿýÿÿÿýÿÿþÿÿÿÿþÿýÿÿÿÿÿÿÿÿýµÿïÿÑÿŠÿÐÿíÿýÿÿúýÿøÿòÿñ¸ÿþïÿÑÿŠÿÐÿ‚ÿèÿîÿÑÿŠÿÐÿ‚ÿÓÿÑÿŠÿÐÿ‚ÿÓÿÑÿŠÿÐÿ‚ÿÓÿÛÿùÿŠÿÚÿøÿ‚ÿóÿÿÿÿèÿßÿöþÿŠÿßÿõþÿ‚ÿôÿüÿèÿáÿýúÿúŠÿáÿýúÿúêÿúÿÿúÿüÿðÿþÿÿ¾ÿûÿèÿãÿýõÿýŠÿãÿýôÿþêÿûÿüûÿÿÿÿñÿýÿ¿ÿûÿÿÿùñÿäÿþ‚ÿ÷ÿäÿþØÿûÿôÿîÿüÿ¾ÿþÿÿÿÿûÿñÿæÿþ‚ÿõÿæÿþØÿùÿûÿúÿüÿüÿüþÿüÿÿÿýÿýÈÿþÿÿÿÿÿÿýñÿèÿþ‚ÿóÿçÿþØÿÿúÿþÿÿÿÿÿÿÿÿÿÿÿýÿÿÿÿÿÿúÿÈÿþÿ ÿÿÿÿÿÿñÿêÿþ‚ÿòÿêÿþÖÿÿýýÿþÿÿÿÿÿÿÿÿÿÿÿÿýÿ ÿÿÿÿÿþÿýÉÿþÿóñÿýîÿþ‚ÿðÿüîÿþÕÿÿýÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÿÿÿÿÿÿÿ¥ÿüóÿü‚ÿíÿýòÿüÕÿôÿëÿûÿÿï¢ÿüøÿýÿ‚ÿëÿüøÿýÿÿ‚ÿ³ÿôþÿ‚ÿèÿôýÿ‚ÿ¯ÿûûÿ‚ÿäÿûúÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ¥ÿü‚ÿÚÿû‚ÿ¦ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¤ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿÍÿ¦´ÿ¥‚ÿúÿØÿÓÿ´ÿÕÿÖÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿÛÿýÒÿ´ÿ©ÿ‚ÿúÿÜÿûÓÿ´ÿ©ÿ‚ÿúÿêÿúÿýÿÿÿÿÿýþÿöæÿ´ÿàÿüþÿþÿýÚÿ‚ÿúÿéÿûÿüýÿþÿüÿÿöæÿ´ÿàÿüýÿùÛÿ‚ÿúÿéÿýÿúÿÿýÿûÿÿøÿæÿ´ÿáÿüÿÿúÿÿÿÿüâÿ‚ÿúÿéÿýÿþÿþÿùÿþÿ÷ÿæÿ´ÿáÿüÿûþÿþÿûâÿ‚ÿúÿêÿÙçÿ´ÿàÿþÿÿÿÿýÿÿÿÿâÿ‚ÿúÿáÿõÿûÿÞÿ´ÿàÿþÿþÿùÿþÿÿâÿ‚ÿúÿ¨ÿ´ÿâÿûÿõÿÿüâÿ‚ÿúÿ¨ÿ´ÿÙÿöÿþáÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¦´ÿ¥‚ÿúÿ¦´ÿ¥‚ÿÐÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ¥ÿü‚ÿÚÿû‚ÿ¦ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¤ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ»ÿΊÿ΂ÿðÿýÿëÿΊÿ΂ÿðÿþÿëÿÑÿŠÿÐÿëÿüüÿþÿÿ—ÿýÿëÿÑÿŠÿÐÿìÿûýÿýÿ²ÿýÿùÿõÿüÿÿûòÿÑÿŠÿÐÿíÿþþÿýÿüÿ²ÿÿÿÿþÿÿûÿÿÿÿÿÿÿýñÿÑÿŠÿÐÿíÿùÿüÿÿÿýÿý»ÿþÿùÿþÿÿÿÿÿÿÿÿÿýñÿÑÿŠÿÐÿíÿøÿÿÿÿÿÿúÿ¼ÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿþðÿÑÿŠÿÐÿíÿøÿ ÿÿÿÿÿþÿý¼ÿôÿìÿÿðÿÑÿŠÿÐÿíÿþþÿýÿÿÿÿÿÿÿÿÿ—ÿïÿÑÿŠÿÐÿìÿûþÿï™ÿþïÿÑÿŠÿÐÿêÿ‚ÿîÿÑÿŠÿÐÿ‚ÿÓÿÑÿŠÿÐÿ‚ÿÓÿÑÿŠÿÐÿ‚ÿÓÿÛÿùÿŠÿÚÿøÿ‚ÿóÿÿÿÿèÿßÿöþÿŠÿßÿõþÿ‚ÿôÿüÿèÿáÿýúÿúŠÿáÿýúÿú‚ÿôÿûÿèÿãÿýõÿýŠÿãÿýôÿþ‚ÿõÿûÿÿÿùñÿäÿþ‚ÿ÷ÿäÿþ‚ÿâÿþÿÿÿÿûÿñÿæÿþ‚ÿõÿæÿþ‚ÿàÿþÿÿÿÿÿÿýñÿèÿþ‚ÿóÿçÿþ‚ÿßÿþÿ ÿÿÿÿÿÿñÿêÿþ‚ÿòÿêÿþ‚ÿÞÿþÿóñÿýîÿþ‚ÿðÿüîÿþ‚ÿ¹ÿüóÿü‚ÿíÿýòÿü‚ÿ¶ÿüøÿýÿ‚ÿëÿüøÿýÿÿ‚ÿ³ÿôþÿ‚ÿèÿôýÿ‚ÿ¯ÿûûÿ‚ÿäÿûúÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿ¥ÿü‚ÿÚÿû‚ÿ¦ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¥ÿý‚ÿÙÿý‚ÿ¤ÿ‚ÿ×ÿ‚ÿ£ÿ‚ÿ×ÿ‚ÿÍÿ¦´ÿ¥‚ÿúÿØÿÓÿ´ÿÕÿÖÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿÑÿûÿþãÿ´ÿòÿýßÿýÿþçÿ‚ÿúÿÑÿûÿþãÿ´ÿôÿûßÿýÿþçÿ‚ÿúÿðÿýÿÿüÿÿüÿïþÿþÿüÿúóÿ´ÿôÿÿÿúÿüÿÿöÿûÿþüÿþÿüÿú÷ÿ‚ÿúÿðÿüÿüÿÿöÿõþÿÿÿûÿÿûóÿ´ÿôÿ÷ÿûÿõÿûÿþüÿÿÿûÿÿû÷ÿ‚ÿúÿñÿûÿüÿÿöÿýÿþþÿÿÿÿÿûþÿðÿ´ÿôÿ÷ÿ ÿÿÿÿÿûÿÿþÿÿüÿÿÿûþÿôÿ‚ÿúÿñÿÿøÿõÿýÿýÿþÿÿÿÿûþÿïÿ´ÿôÿþÿûÿþÿÿÿþÿûÿÿúÿüÿÿÿûþÿóÿ‚ÿúÿñÿõÿèÿõÿûòÿ´ÿóÿüúÿüÿÿéÿõÿûöÿ‚ÿúÿïÿüÿüÿýÿõÿöÿéÿ´ÿñÿ÷ÿþýÿøÿîÿíÿ‚ÿúÿ¨ÿ´ÿÔÿýÚÿ‚ÿúÿ¨ÿ´ÿÔÿþÙÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¨ÿ´ÿ©ÿ‚ÿúÿ¦´ÿ¥‚ÿúÿ¦´ÿ¥‚ÿÐÿ‚ÿßÿû‚ÿŸÿ‚ÿäÿú‚ÿ›ÿ‚ÿèÿú‚ÿ—ÿ‚ÿìÿú‚ÿ“ÿ‚ÿðÿú‚ÿÿ‚ÿôÿû‚ÿŠÿ‚ÿøÿû‚ÿ†ÿ‚ÿüÿû‚ÿ‚ÿ‚ÿÿû‚ÿ‚ÿÿÿü‡ÿú‚ÿ‚ÿúÿý‹ÿú‚ÿ‚ÿöÿýÿú‚ÿ‚ÿòÿý“ÿú‚ÿ‚ÿîÿý—ÿû‚ÿ‚ÿèÿšÿû‚ÿ‚ÿäÿžÿû‚ÿ‚ÿàÿ¢ÿû‚ÿ‚ÿÜÿ§ÿú‚ÿ‚ÿ‚ÿÿÿú‚ÿ‚ÿÙÿó¶ÿú‚ÿ‚ÿÚÿøúÿù¿ÿú‚ÿ‚ÿØÿýíÿüÆÿû‚ÿ‚ÿÖÿýçÿýÌÿû‚ÿ‚ÿÿÿýÿÞÿüãÿüÓÿû‚ÿ‚ÿûÿýÿõÿëÿýáÿý×ÿû‚ÿ‚ÿ÷ÿñÿëÿúæÿýÿÜÿú‚ÿ‚ÿùÿüÿúÿýÿùìÿþÿýëÿýýÿàÿú‚ÿ‚ÿõÿ ÿÿÿÿÿúÿýëÿüÿúõÿúûÿäÿú‚ÿ‚ÿñÿÿÿÿÿÿÿÿþÿþÿëÿøÿîøÿèÿú‚ÿ‚ÿíÿÿÿÿÿÿÿÿÿÿþÿýëÿðÿþðÿìÿû‚ÿ‚ÿèÿüÿüÿÿøÿþìÿÜÿðÿû‚ÿ‚ÿØÿÞÿÜÿûÿþýÿû‚ÿ‚ÿÖÿþÞÿÜÿüÿ÷‚ÿ‚ÿÒÿþÞÿÜÿþÿù‚ÿ‚ÿ¨ÿÜÿÿø‚ÿ‚ÿ§ÿÜÿö‚ÿ‚ÿÍÿÿÿÿâÿÜÿ‚ÿ‚ÿÄÿüÿâÿÜÿ‚ÿ‚ÿÄÿûÿâÿÜÿ‚ÿ‚ÿÅÿûÿÿÿùëÿÜÿ‚ÿ‚ÿÄÿþÿÿÿÿûÿëÿÜÿ‚ÿ‚ÿÄÿþÿÿÿÿÿÿýëÿÜÿ‚ÿ‚ÿÄÿþÿ ÿÿÿÿÿÿëÿÜÿ‚ÿ‚ÿÅÿþÿóëÿÜÿ‚ÿ‚ÿÿÜÿ‚ÿ‚ÿÿþÞÿ‚ÿ‚ÿœÿýãÿü‚ÿ‚ÿšÿüèÿý‚ÿ‚ÿ”ÿýíÿý‚ÿ‚ÿŽÿøüÿø‚ÿ‚ÿ‡ÿõ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿïÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿøÿü‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿ÷ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ¦ÿ¦‚ÿ‚ÿÐÿ¦‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿãÿþýÿøÿþÛÿ‚ÿ‚ÿÐÿãÿþýÿøÿþÛÿ‚ÿ‚ÿÐÿâÿþÿþþÿûÿüÿÿõìÿ‚ÿ‚ÿÐÿâÿþÿþþÿûÿüÿûÿûìÿ‚ÿ‚ÿÐÿâÿýÿýÿÿÿÿþþÿûÿÿéÿ‚ÿ‚ÿÐÿâÿýÿýÿÿÿÿýÿÿûÿÿèÿ‚ÿ‚ÿÐÿäÿõÿèëÿ‚ÿ‚ÿÐÿÈÿãÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¨ÿ‚ÿ‚ÿÐÿ¦‚ÿ‚ÿ¡ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿøÿü‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿøÿý‚ÿ‚ÿ‚ÿ÷ÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿöÿ‚ÿ‚ÿ‚ÿ÷ÿû‚ÿûÿü‚ÿÿìŒÿì‚ÿ˜ÿûóÿû‘ÿûòÿû‚ÿžÿüëÿü–ÿýêÿý‚ÿ¢ÿýåÿý›ÿüæÿüôÿýõÿóÿöúÿÿÿÿðÿ‚ÿþÿýàÿþžÿþàÿþõÿûøÿóÿóþÿÿÿñÿ‚ÿþÿüãÿüžÿüäÿüôÿÿ÷ÿôÿ ÿÿÿÿÿÿþþÿýÿ‚ÿìÿÿüéÿüÿÿžÿÿÿýèÿýÿÿôÿÿöÿÿüÿý ÿÿÿÿÿþÿþÿÿÿüÿúÿûÿùˆÿýÿüîÿýüÿžÿýÿüîÿüýÿôÿú ÿÿÿÿÿÿýÿÿÿÿÿüÿþÿþÿÿÿÿÿÿÿÿÿþÿÿûÿˆÿúÿøýÿ÷úÿžÿúÿøüÿøúÿôÿþÿÿÿÿÿÿÿÿÿû ÿÿÿÿÿÿþÿþÿÿÿÿÿÿÿÿÿþÿþÿÿÿÿýˆÿõÿõôÿžÿôÿöôÿôÿþÿÿÿÿÿÿÿÿÿÿþÿÿÿÿýÿÿÿýÿÿÿÿÿÿÿÿÿÿþÿ ÿÿÿÿˆÿÜÿžÿÜÿõÿýÿÿþÿïÿÿÿýÿÿúþÿöÿöÿöˆÿÜÿžÿÜÿÞÿüÿ‚ÿõÿüÿæÿÜÿžÿÜÿÞÿü‚ÿùÿüÿýÿæÿÜÿøÿþªÿÜÿÝÿþ‚ÿùÿüÿüÿæÿÜÿüÿúªÿÜÿ‚ÿìÿýÿüÿóÿõÿÿÿýëÿÜÿþÿ¤þÿÜÿ‚ÿìÿüÿþÿÿûÿý ÿÿÿÿþÿÿÿÿüìÿÜÿüÿúªÿÜÿ‚ÿìÿüÿ ÿÿÿÿþÿ ÿÿÿÿüÿÿÿÿÿéÿÜÿøÿþªÿÜÿèÿèÿÿÿÿñÿ¹ÿÿÿÿþÿÿÿÿÿý ÿÿÿÿþ ÿÿÿÿÿÿÿìÿÜÿžÿÜÿèÿéÿÿÿòÿ¹ÿúÿöÿïÿùìÿÜÿžÿÜÿèÿèÿýÿ‚ÿãÿÜÿžÿÜÿõÿýÿüÿýþÿüÿùÿýþÿÿÿôÿüÿýÿý‚ÿþÿÜÿžÿÜÿõÿÿÿÿýÿþÿÿÿÿùüÿÿÿÿÿý ÿÿÿÿÿÿÿúÿ‚ÿþÿÜÿžÿÜÿôÿþÿÿýÿþÿÿÿûþÿüÿÿÿÿÿÿþþÿþÿÿÿÿþÿý‚ÿþÿÜÿžÿÜÿõÿÿÿÿýÿþÿÿÿÿýÿÿþüÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿ‚ÿþÿÜÿžÿÜÿõÿñÿÿïþÿóÿí‚ÿþÿÜÿžÿÜÿ‚ÿ¨ÿýàÿþžÿþàÿþ‚ÿ¦ÿýåÿý›ÿüæÿü‚ÿ£ÿüëÿü–ÿýêÿý‚ÿÿûóÿû‘ÿûòÿû‚ÿ˜ÿìŒÿì‚ÿŽÿû‚ÿûÿü‚ÿóÿ€ endstream endobj 9 0 obj 11451 endobj 10 0 obj /DeviceGray endobj 11 0 obj << /Filter [ /RunLengthDecode ] /Width 84 /Height 106 /ColorSpace 10 0 R /BitsPerComponent 8 /Length 12 0 R >> stream ‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚ó€ endstream endobj 12 0 obj 143 endobj 13 0 obj endobj 14 0 obj 143 endobj 15 0 obj << /Type /XObject /Subtype /Image /Name /Ma0 /Filter [ /RunLengthDecode ] /Width 394 /Height 499 /ColorSpace /DeviceGray /BitsPerComponent 8 /Length 16 0 R >> stream «ÏD‚‚¨™ÑDwD‚‚Ô3DD3õUæˆÑDD‚‚ÔÿwU»fø3ÿæˆÑDD‚‚ÓÿDU»÷ÿæˆÑDD‚‚ÓÿDfªfªªwUª3ÿwUª3wf»ˆñˆÑDD‚‚Óÿwf™DÌwU"ÝÿwU"Ý3»ˆwñˆÑDD‚‚ÓÿDþD»»Uÿÿ»Uÿ"̈3ñˆÑDD‚‚ÓÿDþD»ˆˆÝÿˆˆÝˆU"ðˆÑDD‚‚ÔDÿˆwÝ3ªUwD3ÿ3ªUwD"Ì»ªUñˆÑDD‚‚½U3"DˆñˆÑDD‚‚½™ˆDUUñˆÑDD‚‚¼DD"ðˆÑDD‚‚¨ˆÑDD‚‚¨ˆÛùDD‚‚¨ˆß"w™™þˆªªˆ3þDD‚‚ÈUUDUèˆáD™™3ú3wª™UDD‚‚Ɉˆ0ª3ÿèˆã"™ˆõf»N‚‚É»ûÿèˆäˆ™"‚‚¸fÿˆ"3Ýÿwˆ»"ffwñˆæD»D‚‚µÿþ ÿÿˆfDÌ›ˆ3ñˆèˆˆ‚‚³ÿþ ÿÿ»»»3ñ£"êU»3‚‚²ÿþ ÿÿ™wif»ñ3™™Uî"ªw‚‚±3ÿU3ÿ33ÿ33î»™UUwïfªˆ"óˆ™z3‚‚Š"ˆªw3ø"ˆª3ˆD‚‚‡3ˆ™™wýDˆ™ˆ"þˆD‚‚ƒ3UˆwD"ûˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚ø"ãççï‚‚‚øÖÿÿÏ‚‚‚øÁÿÿ¯‚‚‚øzÿÿ`‚‚‚ø"óï‚‚‚÷áÛ‚‚‚öÊÄ‚‚¡™Øˆþӈf‚‚ЈØÓˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Јàˆ»ˆýUÌîˆÔˆ‚‚Јà3w»þ"ÿUDÝUÕˆ‚‚Ðˆç »»™»ª3D»þUÌwª»Uª»U™»»ˆ"»ª»ˆ»ˆèˆ‚‚Јç wÿˆDˆîD»û™ÌˆÌUªfî"wDDÝD™ªwîUÿ舂‚ЈçDÿþÿDD»ý »Ì"ÿ™ÿ™ª»þÿDˆˆD»ÿ舂‚Јç DÿˆDˆîD»þ3̪UUÝÿªÿwˆ»"ÝDˆˆD»ÿ舂‚ЈçDÿ™Ýª33ýÿ»ˆýÿ ˆ™ª"ÿ33îÿÿîþÿfÿfÿªéˆ‚‚ЈçDÿçD߈‚‚ЈçÌÿ»3ƈ‚‚Јç3DDň‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚ЙØD\PÓDˆ‚‚Ð×D§uÓD"‚‚¦ˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öfD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚ø"§¾¾Ÿ‚‚‚øãÿÿÝ‚‚‚øÏÿÿÈ‚‚‚ø§ÿÿ’‚‚‚øDÿø3‚‚‚÷ëê‚‚‚öÛׂ‚éDÈÄéD‚‚¨™êDiiêDwD‚‚Ó DD3"DDDDþý3Dý3DòˆÑDD‚‚Ó 3ÿ"»ˆUwþ™fþÝ™þ"ÿˆñˆÑDD‚‚Ò»fU݈þª»ý™ÿ"ẅñˆÑDD‚‚Òf»fÝ3ˆþfÝDþˆ™ˆˆ»ˆñˆÑDD‚‚Òÿ"ˆˆ™U3þˆw™þˆDîf"»ˆñˆÑDD‚‚Ѫ™f"îˆþD™ˆˆÿ"ˆ»wˆ»ˆñˆÑDD‚‚ÑUÿ̈þˆþ ™ˆˆUî3»ˆñˆÑDD‚‚Јf3UªˆîDUÌ3™3ݪòˆÑDD‚‚¨ˆÑDD‚‚¨ˆÑDD‚‚¨ˆÑDD‚‚¨ˆÑDD‚‚¨ˆÛùDD‚‚¨ˆß"w™™þˆªªˆ3þDD‚‚ÈUUDUèˆáD™™3ú3wª™UDD‚‚Ɉˆ0ª3ÿèˆã"™ˆõf»N‚‚É»ûÿèˆäˆ™"‚‚¸fÿˆ"3Ýÿwˆ»"ffwñˆæD»D‚‚µÿþ ÿÿˆfDÌ›ˆ3ñˆèˆˆ‚‚³ÿþ ÿÿ»»»3ñ£"êU»3‚‚²ÿþ ÿÿ™wif»ñ3™™Uî"ªw‚‚±3ÿU3ÿ33ÿ33î»™UUwïfªˆ"óˆ™z3‚‚Š"ˆªw3ø"ˆª3ˆD‚‚‡3ˆ™™wýDˆ™ˆ"þˆD‚‚ƒ3UˆwD"ûˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚ø"ãççï‚‚‚øÖÿÿÏ‚‚‚øÁÿÿ¯‚‚‚øzÿÿ`‚‚‚ø"óï‚‚‚÷áÛ‚‚‚öÊÄ‚‚¡™Øˆ½ӈf‚‚ЈØÓˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚ЈÔUÌîˆÙˆ‚‚ЈÕ"ÿUDÝUÚˆ‚‚Јé%ª»Uª»U™»»ˆ"»ª»ˆ»ˆỦ»ª»ˆ»ˆ™»»ˆæˆ‚‚ЈéˆÌUªfî"wDDÝD™ªwîUÿý™Ì™ªwîUÿwDDÝD爂‚Јé"ÿ™ÿ™ª»þÿDˆˆD»ÿ»ÌˆˆD»ÿ»þÿD爂‚Јè%Ýÿªÿwˆ»"ÝDˆˆD»ÿ3̪UUˆˆD»ÿˆ»"ÝD爂‚Ðˆè ™ª"ÿ33îÿÿîþÿfÿfÿªˆýÿ—ÿÿfÿfÿª3îÿÿîÿ"舂‚ЈàDèD䈂‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚ЙØD\PÓDˆ‚‚Ð×D§uÓD"‚‚¦ˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öfD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚ø"§¾¾Ÿ‚‚‚øãÿÿÝ‚‚‚øÏÿÿÈ‚‚‚ø§ÿÿ’‚‚‚øDÿø3‚‚‚÷ëê‚‚‚öÛׂ‚éDÈÄéDŠ3ÐD3šDùDâDýUë™êDiiêDwDŠˆÐDˆ›ªúªâw»þ3ÿëˆÑDDŠˆÐˆíûD3þDÚD·D»ýÿëˆÑDDŠˆÐˆí ÿwDD»ÿwDˆ»"é÷ªúñUªfªffÌU3Ýf»ˆÌD3Ýý("ˆUˆ"ffw"ffwwˆ»UªfªffÌUDÝ™ÝfÿwÝ"»òˆÑDDŠˆÐˆì ÿD"ÿDUÝëªïªðÌD»D™ÿDÌUˆÿý'DUÿwˆ3wˆ3ˆfDÌDÌD»D™D»3îÿÝ""fñˆÑDDŠˆÐˆìÿDDDÿDþÝUþ)wU™ wUª3f»ˆÌD"ffwwÝffªªˆ"ˆUˆ3Ýf»ˆÌDwÝfñ%»D»D»ÿD»Dˆÿf»»wDÿ»»3»»3»þ»D»D»D»ÿÿfˆfñˆÑDDŠˆÐˆìÿ™ˆªDÿDþ»ˆþ(ˆDU‰U"ÝDÌUˆwˆ3D»DÌDUÿÿDÌUˆD»ð»D»D»ÿD»Dˆÿý&wwÿDf»Df»™w3»D»D»D»ÝÿÝwðˆÑDDŠˆÐˆìÿD"ÿDþÝDþ»"»UÿD»Dˆ»»3D»D»þ wDÿÿD»DˆD»ñDÝ"wÝ"wÌNÿ3fÝ"ˆª3ÿ3þ&wÌfÌUˆUUwˆUUw3î»™PÝ"wÝ"wÌ"3ÌDw33ÿ3ˆ3ðˆÑDDŠˆÐˆìÿDýÿDf»ý(™wŸˆÝD»DˆDf»D»D»wwÿÿD»DˆD»µˆïˆÑDDŠˆÐˆíUÿˆ3ÿ™þˆý)"Ý»ˆªUwDfÝ"ˆªUUw"ÝfwÝ3wÌfÌU3ÿ3fÝ"ˆª0Ýf¸ˆ™UïˆÑDDŠˆÐˆ‚è"3îˆÑDDŠˆÐˆ‚ÓˆÑDDŠˆÐˆ‚ÓˆÑDDŠˆÐˆ‚ÓˆÛùDDŠˆÚ"øˆ‚óUUDUèˆß"w™™þˆªªˆ3þDDŠˆßf™ªþˆªˆˆUþˆ‚ôˆˆ0ª3ÿèˆáD™™3ú3wª™UDDŠˆá"ˆ™Uúf™™fˆê"úUUDúDüDðUUDU¾»ûÿèˆã"™ˆõf»NŠˆãˆ™"ôU™™êˆˆûˆˆ0ªûªªñˆµ3ÿ¿fÿˆ"3Ýÿwˆ»"ffwñˆäˆ™"‚÷ˆäUªDØDˆû»ôªî»üÿ¾ÿþ ÿÿˆfDÌ›ˆ3ñˆæD»D‚õˆæ™ˆØ(fU™ˆwˆ»fÿˆ"3Ýf»ˆÌD3ÝwÝf3ÝwUª3f»ˆÌDþfÿˆNÝÿwˆ»"ffwÈÿþ ÿÿ»»»3ñˆèˆˆ‚óˆçfª"Ø wUDˆˆfDÌDÿþÿDÌUˆÿD»ÿwU"ÝDÌUˆýÿÿÿˆfDÌDwˆ3Èÿþ ÿÿ™wif»ñ£"êU»3‚òŽ3ê"ªfÖ»DDˆ»ýÿþÿD»DˆÿD»ÿ»UÿD»Dˆý ÿÿÿ»þ»»3É3ÿU3ÿ33ÿ33î»™UUwñ3™™Uî"ªw‚ðwªfîˆ™Õ ™fDˆ™w3ÿþÿD»DˆÿD»ÿˆˆÝD»Dˆýÿÿÿ™w3Df»¥fªˆ"óˆ™z3‚íU™™Uòf»D33Õ>3݈™Ì@î»™3ÿU3ÿ3fÝ"ˆª@ÿ3"Ýf3ÿ3ªUwDfÝ"ˆª3ÿU3ÿ33ÿ33î»™ˆUUw¢"ˆªw3ø"ˆª3ˆD‚ëf™ˆUøf»fDD‚³3ˆ™™wýDˆ™ˆ"þˆD‚èf™ªˆUþDwª™UýDD‚¯3UˆwD"ûˆD‚ä"DˆˆUDúDD‚£ˆD‚×DD‚£ˆD‚×DD‚£ˆD‚×DD‚£DD‚×DD‚£DD‚×DD‚£DD‚×DD‚£DD‚×DD‚¥"ãççï‚Úêþ炦ÖÿÿÏ‚ÙÏÿÿÖ‚¥Áÿÿ¯‚Ù¯ÿÿ·‚¥zÿÿ`‚Ù`ÿÿz‚¥"óï‚Ùïó"‚¤áÛ‚×áá‚£ÊÄ‚×Äт͙؈þӈf´3Õˆ¸ÈÕˆ3‚úˆØÓˆ´DDÕ"ÖDD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆÛUÌîˆÒˆ´DD©DD‚úˆÜ"ÿUDÝUÓˆ´DD©DD‚úˆê"»ª»ˆ»ˆ™»»ˆUÌw™»»ˆþ U»»ªz»ª»ˆ»ˆæˆ´DDà3ª»™þ"»ˆUÌîˆÚDD‚úˆé ™ªwîUÿwDDÝDý™ÌwDDÝDÿˆD™w™ªwîUÿ戴DD່Dˆýw»"ÿUDÝUÛDD‚úˆéˆˆD»ÿ»þÿ D»Ì»þÿ Dˆîÿª3ˆˆD»ÿ戴DDáªîÌ»fˆÌ̪»UÌwD»»ªˆâDD‚úˆé%ˆˆD»ÿˆ»"ÝD3̪UUˆ»"ÝD"ªªªˆˆD»ÿ戴DDá DÌwD"fÝUDÌ»þ ™Ì"ÿwDˆ»âDD‚úˆê"ÿÿfÿfÿ»îÿÿîÿ"ˆýÿˆ3îÿÿîÿ"3þÿîkÿÿfÿfÿªçˆ´DDà»DþˆˆU»»Ìw»DâDD‚úˆáDõDûDÞˆ´DDà»Dþw»ª»3̪UUUÝwâDD‚úˆ¨ˆ´DDâ"ýÿf»ÿÿÝÿÇýÿˆˆþÿ»âDD‚úˆ¨ˆ´DDÙ""öDáDD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚ú™ØD\PÓDˆ´DwÖDPPÖDwD‚ú×D§uÓD"´ÕDuuÕD‚ЈD‚×DD‚£ˆD‚×DD‚£ˆD‚×DD‚£ˆD‚×DD‚£ˆD‚×DD‚£fD‚×DD‚£DD‚×DD‚£DD‚×DD‚£DD‚×DD‚¥"§¾¾Ÿ‚Ú§¾¾Ÿ‚¦ãÿÿÝ‚ÙÝÿÿã‚¥ÏÿÿÈ‚ÙÈÿÿÏ‚¥§ÿÿ’‚Ù’ÿÿ§‚¥Dÿø3‚Ù3øÿD‚¤ëê‚×êî‚£Ûׂ××Û‚»éDÈÄéDŠ3éD½ÏêD3‚ðDýUë™êDiiêDwDŠˆéD\uêDˆ‚ðw»þ3ÿëˆÑDDŠˆÐˆëDD"üUUDU—D»ýÿëˆÑDDŠˆÐˆìf™3"™»ýˆµ3ÿ²("ˆUˆ"ffw"ffwwˆ»UªfªffÌUDÝ™ÝfÿwÝ"»òˆÑDDŠˆÐˆíDîþˆý»üÿ²'DUÿwˆ3wˆ3ˆfDÌDÌD»D™D»3îÿÝ""fñˆÑDDŠˆÐˆí™™ùfÿˆNÝÿwˆ»"ffw»wDÿ»»3»»3»þ»D»D»D»ÿÿfˆfñˆÑDDŠˆÐˆí»ˆøÿÿÿˆfDÌDwˆ3¼&wwÿDf»Df»™w3»D»D»D»ÝÿÝwðˆÑDDŠˆÐˆíˆªø ÿÿÿ»þ»»3¼&wÌfÌUˆUUwˆUUw3î»™PÝ"wÝ"wÌ"3ÌDw33ÿ3ˆ3ðˆÑDDŠˆÐˆí3ÿ"þ3ýÿÿÿ™w3Df»—ˆïˆÑDDŠˆÐˆìU»wUˆ3þ3ÿU3ÿ33ÿ33î»™ˆUUw™ˆ™UïˆÑDDŠˆÐˆê""‚"3îˆÑDDŠˆÐˆ‚ÓˆÑDDŠˆÐˆ‚ÓˆÑDDŠˆÐˆ‚ÓˆÛùDDŠˆÚ"øˆ‚óUUDUèˆß"w™™þˆªªˆ3þDDŠˆßf™ªþˆªˆˆUþˆ‚ôˆˆ0ª3ÿèˆáD™™3ú3wª™UDDŠˆá"ˆ™Uúf™™fˆ‚ô»ûÿèˆã"™ˆõf»NŠˆãˆ™"ôU™™‚õfÿˆ"3Ýÿwˆ»"ffwñˆäˆ™"‚÷ˆäUªD‚âÿþ ÿÿˆfDÌ›ˆ3ñˆæD»D‚õˆæ™ˆ‚àÿþ ÿÿ»»»3ñˆèˆˆ‚óˆçfª"‚ßÿþ ÿÿ™wif»ñ£"êU»3‚òŽ3ê"ªf‚Þ3ÿU3ÿ33ÿ33î»™UUwñ3™™Uî"ªw‚ðwªf‚¹fªˆ"óˆ™z3‚íU™™Uòf»D33‚¶"ˆªw3ø"ˆª3ˆD‚ëf™ˆUøf»fDD‚³3ˆ™™wýDˆ™ˆ"þˆD‚èf™ªˆUþDwª™UýDD‚¯3UˆwD"ûˆD‚ä"DˆˆUDúDD‚£ˆD‚×DD‚£ˆD‚×DD‚£ˆD‚×DD‚£DD‚×DD‚£DD‚×DD‚£DD‚×DD‚£DD‚×DD‚¥"ãççï‚Úêþ炦ÖÿÿÏ‚ÙÏÿÿÖ‚¥Áÿÿ¯‚Ù¯ÿÿ·‚¥zÿÿ`‚Ù`ÿÿz‚¥"óï‚Ùïó"‚¤áÛ‚×áá‚£ÊÄ‚×Äт͙؈þӈf´3Õˆ¸ÈÕˆ3‚úˆØÓˆ´DDÕ"ÖDD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆÑ»»ûˆ»ˆãˆ´DDòfˆD3߈ˆýˆ»ˆçDD‚úˆÑwÿû3w»ãˆ´DDôÌ̪Ýÿß33ý3w»çDD‚úˆð$™»»ˆU»»ªfU»»ªfU»»ˆ"»ª»ˆ»ˆDÿªÝª3þD»þ U»»ˆ"»»U»ªóˆ´DDôw»"îúD»»ªˆU»»™0»ª»ˆ»ˆ»»™»ª3ˆ»ˆüD»þ U»»ˆ"»»U»ª÷DD‚úˆð$wDDÝDÿˆD™wÿˆD™wUîUD»™™ªwîUÿDÿˆDˆÝþD»UîUD»™DÿÝUwóˆ´DDôªˆ÷"ÿwDˆ»DîfDª»™ªwîUÿwÿˆDˆî3w»üD»UîUD»™DÿÝUw÷DD‚úˆñ»þÿDˆîÿª3ˆîÿª3ªÝ»»ÌÿˆˆD»ÿDÿþ ÿDD»ªÝ»»Ìÿþÿðˆ´DDô™ˆ÷w»DˆˆÿˆˆD»ÿDÿþÿDD»ü D»ªÝ»»ÌÿþÿôDD‚úˆñ2ˆ»"ÝD"ªªª"ªªªwÝUDUwˆˆD»ÿDÿDDîD»wÝUDUwþÿDDôfÝ"™ûUÝwfÝw݈ˆD»ÿDÿˆDˆîD»ü D»wÝUDUwþÿóDD‚úˆñ3îÿÿîÿNþÿîU3þÿîU»þÿ»"ÿÿfÿfþÿîÿîf3ýÿ»»þÿ»fýÿ"òˆ´DDóˆþÿˆúˆþÿ»ˆÿÿÝNÿÿfÿfÿªDÿ™Ýª33ýÿ»3ýÿ»»þÿ»fýÿ"öDD‚úˆïDüDüDý"DõDö"D鈴DDñD÷Dý3øDÿî"DíDD‚úˆ¨ˆ´DDÔÌÿ»3ÚDD‚úˆ¨ˆ´DDÔ3DDÙDD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚úˆ¨ˆ´DD©DD‚ú™ØD\PÓDˆ´DwÖDiÕDwD‚ú×D§uÓD"´ÙDu§À´›ÔD‚ЈD‚ßDˆ™ªw3‚ŸˆD‚äUˆ™™f"‚›ˆD‚èUˆ™™f"‚—ˆD‚ì"f™™ˆU‚“ˆD‚ð"f™™ˆU‚fD‚ô3wª™ˆD‚ŠDD‚ø3w™ªˆD‚†DD‚üDˆª™w3‚‚DD‚Dˆ™ªw3‚‚"§¾¾Ÿ‡Uˆ™™f"‚‚úãÿÿÝ‹Uˆ™™f"‚‚öÏÿÿÈ"f™™ˆU‚‚ò§ÿÿ’“"f™™ˆU‚‚îDÿø3—3wª™ˆD‚‚èëêš3w™ªˆD‚‚äÛמDˆª™w3‚‚൯¢Dˆ™ªw3‚‚Ü33§Uˆ™™f"‚‚‚Uˆ™™f"‚‚Ù 3Dwˆ™ˆ™»ˆ»ˆˆDD¶"f™™ˆU‚‚Ú"wˆªˆˆUDúDDˆˆ»ˆ™3¿"f™™ˆU‚‚ØU™™3íw»wÆ3wª™ˆD‚‚Ö"ˆªfçD™™UÌ3w™ªˆD‚‚DýUÞpªˆ"ãfªˆ"ÓDˆª™w3‚‚ûw»ý™õëPÍ™Dá"ˆµ¹×Dˆ™ªw3‚‚÷D»ñªëDDw»w"æf™™3ˆÜUˆ™™f"‚‚ùwUª3DÝ™Ýf3Ìwˆ»wU™wÝfìDDþ3™™Uë3ˆªfýˆàUˆ™™f"‚‚õwU"ÝD»3fDÌDˆDU"D»ëDDüfªˆˆDDõ3Dwˆªˆ"ûˆä"f™™ˆU‚‚ñ»UÿD»ÿ»»þ»"þD»ëDDøDDˆˆ»ˆ»ˆˆwˆªˆªˆˆUDøˆè"f™™ˆU‚‚툈ÝD»Ý»™w3™w3D»ëDDð3Dðˆì3wª™ˆD‚‚èªUwD3ÌDw3»3î»™"Ý»ˆ"ÝfìDD܈ð3w™ªˆD‚‚Ø»ÞDD܈û§zýDˆª™w3‚‚Öw3™ÞDD܈ü ’èÿÈDˆ™ªw3‚‚Ò"DÞDD܈þzßþÿñf"‚‚¨DD܈”øüÿñ"‚‚§DD܈"\PýDPu‚‚ÍUUDUâDD܈‚‚Ĉˆ0ª3ÿâDD܈‚‚Ä»ûÿâDD܈‚‚Åfÿˆ"3Ýÿwˆ»"ffwëDD܈‚‚Äÿþ ÿÿˆfDÌ›ˆ3ëDD܈‚‚Äÿþ ÿÿ»»»3ëDD܈‚‚Äÿþ ÿÿ™wif»ëDD܈‚‚Å3ÿU3ÿ33ÿ33î»™UUwëDD܈‚‚DD܈‚‚@„ÞUŽ‚‚œU™™Dã"ˆªf‚‚šwªˆ"èfªˆ3‚‚”3™™fí3™™f‚‚ŽfªˆªˆˆUDüDDˆˆ»ˆªw"‚‚‡ 3Dwˆªˆˆ»ˆˆDD‚‚‚‚‚‚ï"‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öfD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚ø"§¾¾Ÿ‚‚‚øãÿÿÝ‚‚‚øÏÿÿÈ‚‚‚ø§ÿÿ’‚‚‚øDÿø3‚‚‚÷ëê‚‚‚öÛׂ‚¦"ÓDÈÄ×D‚‚ЈÓDiiØD™‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Јãˆ»ˆýˆˆøf»3Ûˆ‚‚Јã3w»ý33ø"ÌDÛˆ‚‚ЈâD»þˆ»ˆþf»ˆ»ª»Dª»ˆU»»ˆ"»»U»ª숂‚ЈâD»þ3w»þ"ÿ™Dªˆ»ˆîw"UîUD»™DÿÝUw숂‚ЈâD»ýD»ýÿˆˆ»ÿ»þ ªÝ»»Ìÿÿ鈂‚ЈâD»ýD»ýÿˆˆ»wÌ™wÝUDUwÿ舂‚Јä3ýÿ»3ýÿ»ªÿ»"ÿÿ—ÿDwÿÿ"»þÿ»fýÿ"눂‚ЈÈ"D㈂‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚Ј¨ˆ‚‚ÐfÓˆ·ŸØˆ™‚‚¡ˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öˆD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚öDD‚‚‚ø"ãççï‚‚‚øÖÿÿÏ‚‚‚øÁÿÿ¯‚‚‚øzÿÿ`‚‚‚ø"óï‚‚‚÷áÛ‚‚‚öÊÄ‚‚‚öu‚‚‚ö‚‚‚÷DDfD"‚û3DfD3‚ DUˆˆªˆªˆwDDfˆý™ˆfDŒ"DwˆªˆªˆˆUDDˆˆ»ˆ»ˆˆD3‚˜"ˆ™wD3ó"DU™ˆU‘fªˆDDòDDˆªf‚žf™ˆ"ëfªˆ"–D™™UêD™™D‚¢3™™Uå3ˆªf›"w»wæfªˆ"ô3DD3õUó3ûD3þDúUDDðD‚þ0Þ€"àf»£žÊ­3à3­ÊõÿwU»fø3ÿó »ÿwDD»ÿwDˆ»"þ3ÿªw»ñª‚þDu™™Uã"ˆªfž—ˆªwäfªˆ—ôÿDU»÷ÿô3ˆÿD"ÿDUÝþÿýD»‚ìDDfªˆ"éfªˆ"ˆžˆD™™UèD™™Uˆô'ÿDfªfªªˆwUª3ÿwUª3wf»ˆˆ3ÿDDDÿDþÝUþ!ÿ3ÝDÝ™Ýffªª—ˆUˆfªªˆ3Ýwˆ»"ffwˆDDý"ˆªfîD™™Uüˆžˆýfªˆ"î"ˆªwýˆô'ÿwf™DÌwU"ÝÿwU"Ý3»ˆw»ÿ™ˆªDÿDþ»ˆþÿÿD»3îDÌDUÿDÌþ ÿˆfDÌ›ˆ3ˆDDúUý™ˆfD"ý DUˆˆªˆªwúˆžˆú3ˆ»ˆ»ˆˆDDüDDˆˆªˆªˆ3úˆôÿDþ"D»»Uÿÿ»Uÿ"̈33ˆÿD"ÿDþÝDþÿÿD»ÿD»wDÿD»þ ÿ»»»3ˆDDõ "DUˆˆªˆªˆwD3ôˆžˆô DDˆˆ»ˆ»ˆˆDDôˆôÿDþD»ˆˆÝÿˆˆÝˆU"ˆ3ÿDýÿDf»ýÿÿD»ÝD»wwÿD»þ ÿ™wif»ˆDD܈žˆÜˆõ(DÿˆwÝ3ªUwD3ÿ3ªUwD"Ì»ªU»Uÿˆ3ÿ™þˆþ"3ÿ33ÿ33ÌDw3wÝ3wÌfÌUwÝ33ÿ33î»™UUwˆDD܈žˆÜˆÞU3"Dˆ3‚õDüUæDD܈žˆÜˆÞ™ˆDUU‚ùüw»ý3ÿæDD܈øD§3ªˆÜˆÝDD"‚ùªüD»üÿæDD܈üD§×èÿÿDªˆÜˆ‚ì-wˆ»Dî3ªDwˆ»wU™ˆ»ªˆwÝf"ˆUˆDÝ™Ýfÿwˆ»ëDD܈þ—úÿ§­ˆþˆÜˆ‚ì.ˆfDÌDwªUˆfḐDU"D»ˆˆD»DUÿD»3îÿˆfDÌDìDD܈üD§×èÿÿDªˆÜˆ‚ì»ü ÝD»»"þD»ˆˆD»wDÿD»ÿÿ»éDD܈øD§3ªˆÜˆè"èUDDñD¹.™w3wDÌ™w­w3D»ˆˆD»wwÿD»Ýÿ™w3ìDD܈žˆÜˆèˆˆé3ÿªw»òª¹.3î»™Dˆª™3î»™0Ý»ˆ݈ˆ™"ÝfwÌfÌwÌDw33ÿ33î»™ìDD܈žˆÜˆèDˆèÿýD»‚ãDD܈žˆÜˆõ"ˆUˆf»ˆÌDfU™ˆþˆ»ªˆ"ffwwˆ»fªªˆþ!ÿ3ÝDÝ™Ýffªªˆ"ˆUˆfªªŸÝwˆ»"ffw‚þDD܈žˆÜˆõDUÿDÌUˆwUDˆþD»ˆˆwˆ3ˆfDÌDDÌü!ÿÿD»3îDÌDUÿDÌÿˆfDÌDwˆ3‚þDD܈žˆÜˆô wDÿD»Dˆ»DDˆþ D»ˆˆ»»3»þD»ü ÿÿD»ÿD»þ wDÿD»ÿ»þ»»3‚þDD܈žˆÜˆõwwÿD»Dˆ™fDˆþD»ˆˆDf»™w3D»ü!ÿÿD»ÝD»wwÿD»ÿ™w3Df»‚þDD܈žˆÜˆõ#wÌfÌUfÝ"ˆª@݈™Ì݈ˆ™ˆUUw3î»™wÝ3þ"3ÿ33ÿ33ÌDw3wÝ3wÌfÌUwÝ33ÿ33î»™ˆUUw‚þDD܈žˆÜˆ‚¨¿w"àf™kž—™3à3™—‚¦3™™Uå3ˆªf›"w»wæfªˆ"‚£f™ˆ"ëfªˆ"–D™™UêD™™D‚"ˆ™wD3ó"DU™ˆU‘fªˆDDòDDˆªf‚˜ DUˆˆªˆªˆwDDfˆý™ˆfDŒ"DwˆªˆªˆˆUDDˆˆ»ˆ»ˆˆD3‚ŽDDfD"‚û3DfD3‚ó€ endstream endobj 16 0 obj 14802 endobj 17 0 obj << /Title (compil-scheme) /CreationDate (D:20130423161413) /ModDate (D:20130423161413) /Producer (ImageMagick 6.6.9-7 2012-08-17 Q16 http://www.imagemagick.org) >> endobj xref 0 18 0000000000 65535 f 0000000010 00000 n 0000000059 00000 n 0000000118 00000 n 0000000300 00000 n 0000000383 00000 n 0000000401 00000 n 0000000439 00000 n 0000000460 00000 n 0000012111 00000 n 0000012132 00000 n 0000012160 00000 n 0000012448 00000 n 0000012468 00000 n 0000012484 00000 n 0000012504 00000 n 0000027499 00000 n 0000027521 00000 n trailer << /Size 18 /Info 17 0 R /Root 1 0 R >> startxref 27701 %%EOF gprolog-1.4.5/doc/tbl-contents.tex0000644000175000017500000000013013021324543015214 0ustar spaspa\newpage \setlength{\parskip}{0pt} \tableofcontents \setlength{\parskip}{\saveparskip} gprolog-1.4.5/doc/custom.hva0000644000175000017500000000602113021324543014075 0ustar spaspa% To have a title on the first page \input{article.hva} %\let\oldmeta=\@meta %\renewcommand{\@meta}{% %\oldmeta %\begin{rawhtml} % % % %\end{rawhtml}} \addto{\@meta} {\begin{rawhtml} \end{rawhtml}} \title{GNU-Prolog Manual} % To have colored headings \def\@color{194} \input{fancysection.hva} % comment this to switch off colors % Define a section without no and include it in the TOC % 1= a label (name) for HeVeA (useless for LaTeX) % 2= The text of the section \newcommand{\SectionWithoutNo}[2] {\section*{\aname{#1}{#2}}% \addcontentsline{toc}{section}{\ahrefloc{#1}{#2}}} % Redefine default HeVeA behavior to add References and Index in the TOC \renewcommand{\@indexsection}[1]{\SectionWithoutNo{@index}{#1}} \renewcommand{\@bibliosection}[1]{\SectionWithoutNo{@biblio}{#1}} % To have a copyright footer \htmlfoot{ \rule{\linewidth}{1mm} \input{copyright.tex} Verbatim copying and distribution of this entire article is permitted in any medium, provided this notice is preserved. \ahref{index.html\#copyright}{More about the copyright} } % To set foreground and background colors \renewcommand{\@bodyargs}{TEXT=black BGCOLOR=white} % To only have a reference to a section (without referencing the page) \newcommand{\RefSP}[1]{(section~\ref{#1})} % Url in HTML output \newcommand{\MyUrl}[2]{\ahref{#1}{#2}} \newcommand{\MyUrlHtml}[2]{\ahref{#1}{#2}} \newcommand{\MyEMail}[2]{\@aelement{HREF="mailto:#1"}{#2}} % Ignore vspace{xxx} of the original definition: \newcommand{\BL}{} \newcommand{\SkipUp}{} % To replace @{} in original definition by @{\quad}: \newenvironment{CodeTwoCols}[1][4cm]% {\begin{Indentation}\begin{tabular}{l@{\quad}l}}% {\end{tabular}\end{Indentation}} % To avoid the use of TabularC (\the\tmplg is not ok for HeVeA) % and to avoid vertical lines \newenvironment{PlErrorsNoTitle}% {\par\begin{tabular}{p{}@{\quad}p{}}\hline}% {\end{tabular}} % To use a PNG image instead of an EPS as in the original definition: \newcommand{\InsertImage}[2][]{\begin{center}\imgsrc{#2.png}\end{center}} % To define unknown macros: \newenvironment{multicols}[1]{}{} \def\arraybackslash{} \def\raggedcolumns{} % To give a name to the HTML file containing the index \let\@isection=\@indexsection \renewcommand{\@indexsection}[1]{\@isection{#1}\cutname{gprolog-idx.html}} \setcounter{tocdepth}{3} %To get index citations that point to section titles %this comes from /usr/lib/hevea/makeidx.hva %NB: no longer works in HeVeA 2.0 !!! % %\usepackage{makeidx} %\renewcommand{\index}[1] %{\if@refs\@saveclosed% %\@@indexwrite[default]{#1}{\@currentlabel}{htoc\thetocanchor}%force evaluation %\@restoreclosed\fi} gprolog-1.4.5/doc/Makefile0000644000175000017500000001202513021325532013523 0ustar spaspaPREFIX=gprolog MAIN=$(PREFIX).tex DVINAME=$(PREFIX).dvi PSNAME=$(PREFIX).ps PDFNAME=$(PREFIX).pdf HTMLNAME=$(PREFIX).html CHMNAME=$(PREFIX).chm # Images: # .eps are needed for latex (and hevea) # .pdf are needed for pdflatex # .png are needed for hevea # # There are rules to convert eps -> pdf and eps->png # NB: convert (ImageMagick) is a superb tool for conversion # # For the logo: it is created from the .ico using convert # NB: gprolog.ico[5] means the 5th image of the .ico file (256x256) IMG_EPS=logo.eps compil-scheme.eps debug-box.eps IMG_PDF=$(IMG_EPS:.eps=.pdf) IMG_PNG=$(IMG_EPS:.eps=.png) TEX_SRC=$(MAIN) packages.tex macros.tex body.tex copyright.tex \ cover.tex acknow.tex intro.tex use.tex debugger.tex \ format-defs.tex direct-cc.tex pl-bips.tex fd-cstr.tex \ c-interface.tex references.tex tbl-contents.tex the-index.tex \ version_no.tex TRACE= #TRACE=-trace .SUFFIXES: .SUFFIXES: .html .hva .pdf .gif .png .eps .ps .dvi .aux .toc .idx .tex $(SUFFIXES) help: @echo @echo '*** Please read the README file ***' @echo @echo 'make all make DVI, PDF, PostScript, HTML and CHM versions' @echo 'make dvi make DVI version (needs LaTeX2e)' @echo 'make pdf make PDF version (needs pdflatex)' @echo 'make ps make PostScript version (needs dvips)' @echo 'make html make HTML versions (needs HeVeA)' @echo 'make chm make HTMLHelp version (needs hhc - Win32 only)' @echo @echo 'make clean remove all temporary files' @echo 'make distclean remove all versions and auxiliary files' @echo 'make clean-all remove all versions' @echo @echo 'make help this help' @echo .eps.pdf: epstopdf $< # convert $< $@ # ps2pdf $< $@ #.eps.gif: # convert $< $@ .eps.png: convert $< $@ all: dvi pdf ps html chm logo.eps: ../gprolog.ico convert -scale 150x150 $<[5] $@ # epstopdf does not handle transparency (needed for HeVeA in case the background is colored) logo.png: ../gprolog.ico convert -scale 150x150 $<[5] $@ logo.pdf: ../gprolog.ico convert -scale 150x150 $<[5] $@ dvi: $(DVINAME) $(DVINAME): $(TEX_SRC) $(IMG_EPS) ./do_latex -dvi $(TRACE) $(MAIN) pdf: $(PDFNAME) $(PDFNAME): $(TEX_SRC) $(IMG_PDF) ./do_latex -pdf $(TRACE) $(MAIN) ps: $(PSNAME) $(PSNAME): $(DVINAME) dvips -o $(PSNAME) -D 300 $(DVINAME) html: $(HTMLNAME) html_node/index.html $(HTMLNAME): custom.hva $(TEX_SRC) $(IMG_PNG) hevea -O -s -exec xxdate.exe -fix custom.hva $(MAIN) -o $(HTMLNAME) html_node/index.html: $(HTMLNAME) rm -f html_node/index.html html_node/$(PREFIX)*.html cp $(IMG_PNG) html_node/. (cd html_node && hacha -hrf -tocbis ../$(HTMLNAME) && ./hh_do_hhc_hhk $(PREFIX)) chm: $(CHMNAME) $(CHMNAME): $(HTMLNAME) html_node/hh-$(PREFIX).hhp html_node/index.html -(cd html_node; hhc hh-$(PREFIX).hhp; mv -f $(CHMNAME) ..) 2>/dev/null || exit 0 clean: rm -f $(PREFIX).aux $(PREFIX).toc $(PREFIX).ind $(PREFIX).idx $(PREFIX).log $(PREFIX).out $(PREFIX).ilg rm -f $(PREFIX).pdf.aux $(PREFIX).pdf.toc $(PREFIX).pdf.ind $(PREFIX).pdf.idx rm -f $(PREFIX).dvi.aux $(PREFIX).dvi.toc $(PREFIX).dvi.ind $(PREFIX).dvi.idx rm -rf $(PREFIX)*.htoc $(PREFIX)*.haux $(PREFIX)*.hind $(PREFIX)*.hrf distclean: clean-aux clean-all: rm -f $(DVINAME) $(PDFNAME) $(PSNAME) $(CHMNAME) rm -f $(HTMLNAME) (cd html_node ; rm -f *.hhc *.hhk *.css *.hrf *_motif.gif *.png *.html) clean-aux: rm -f *.aux *.toc *.ind *.idx *.log *.haux *.htoc *.hidx *.hind *.out *.ilg *.hrf *.image.tex clean-full: clean-all clean-aux clean-test: rm -f ?.dvi ?.pdf ?.html ?.ps ?.info ?.txt rm -f ?.aux ?.toc ?.idx ?.ind ?.log rm -f ?.haux ?.htoc ?.hidx ?.hind ?.out ?.ilg ?.hrf # create compressed formats for DVI and HTML in 1 page and HTML 1 page / node COPY_PATH=/tmp DVITGZNAME=$(DVINAME).tar.gz HTMLTGZNAME=$(HTMLNAME).tar.gz HTMLNODETGZNAME=$(PREFIX).html_node.tar.gz copy: $(DVINAME) $(PSNAME) $(PDFNAME) $(HTMLNAME) $(CHMNAME) names cp $(DVINAME) $(IMG_EPS) $(PSNAME) $(PDFNAME) $(HTMLNAME) $(IMG_PNG) $(CHMNAME) $(COPY_PATH)/. tar cf - $(DVINAME) $(IMG_EPS) | gzip > $(COPY_PATH)/$(DVITGZNAME) tar cf - $(HTMLNAME) $(IMG_PNG) | gzip > $(COPY_PATH)/$(HTMLTGZNAME) ( cd html_node ; tar cf - index.html $(PREFIX)*.html $(PREFIX)*.css *.gif *.png| gzip > $(COPY_PATH)/$(HTMLNODETGZNAME) ) NAMES_FILE=$(COPY_PATH)/doc_names names: @echo '# file generated by doc/Makefile' >$(NAMES_FILE) @echo "PREFIX=$(PREFIX)" >>$(NAMES_FILE) @echo "DVINAME=$(DVINAME)" >>$(NAMES_FILE) @echo "PDFNAME=$(PDFNAME)" >>$(NAMES_FILE) @echo "PSNAME=$(PSNAME)" >>$(NAMES_FILE) @echo "HTMLNAME=$(HTMLNAME)" >>$(NAMES_FILE) @echo "CHMNAME=$(CHMNAME)" >>$(NAMES_FILE) @echo "IMG_EPS='$(IMG_EPS)'" >>$(NAMES_FILE) @echo "IMG_PNG='$(IMG_PNG)'" >>$(NAMES_FILE) @echo "DVITGZNAME=$(DVITGZNAME)" >>$(NAMES_FILE) @echo "HTMLTGZNAME=$(HTMLTGZNAME)" >>$(NAMES_FILE) @echo "HTMLNODETGZNAME=$(HTMLNODETGZNAME)" >>$(NAMES_FILE) for-release: all dist-dvi dist-html names gprolog-1.4.5/doc/logo.pdf0000644000175000017500000015117513021352245013531 0ustar spaspa%PDF-1.4 1 0 obj << /Pages 2 0 R /Type /Catalog >> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 3 0 obj << /Type /Page /Parent 2 0 R /Resources << /XObject << /Im0 8 0 R >> /ProcSet 6 0 R >> /MediaBox [0 0 150 150] /CropBox [0 0 150 150] /Contents 4 0 R /Thumb 11 0 R >> endobj 4 0 obj << /Length 5 0 R >> stream q 150 0 0 150 0 0 cm /Im0 Do Q endstream endobj 5 0 obj 31 endobj 6 0 obj [ /PDF /Text /ImageC ] endobj 7 0 obj << >> endobj 8 0 obj << /Type /XObject /Subtype /Image /Name /Im0 /Filter [ /RunLengthDecode ] /Width 150 /Height 150 /ColorSpace 10 0 R /BitsPerComponent 8 /SMask 15 0 R /Length 9 0 R >> stream ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ³ÿõ ý‚ÿ‚ÿ‚ÿéÿõ F)n2|?—FŸ#þ‚ÿ‚ÿ‚ÿûÿ÷1 6Zt$0­CßIáOãTä[å[Ú'[‚ÿ‚ÿŽÿ÷C= T j…¥!Ö%Ú*Þ.â3æ8æ=åCåHåNåSåXà3} ‚ÿ‚ÿ ÿ÷T <N u ž´ÇÒÜéèçå!å%å*å0å5å:å@åFåMåSæ;™ ý‚ÿ‚ÿ¬ÿõ[A lˆ¦ÀÕÛÞæææå å ååååååå å%å,å2å8å=åEåKæA·ý‚ÿ‚ÿÇÿõv, F `qŸ·åååäå å ååååååååååååå åååæç&è,ã0Ù2Î8Æ5¡ %ý‚ÿ‚ÿÙÿõ~  , Mgsš ÊÑÚäèç æ åååååååååååååååæçèãØÌ Æ´"£ ->\ ”$z•8s„6" ‚ÿ‚ÿîÿñ~  ;b~™¨ÉÎÙäèææ å åååååååååååååååååääääƦ mt F†{˜4Ž =§µIÂÈVâßgæäkñðsùùzll5‚ÿ‚ÿúÿ÷~  7 Jm‹¯áåååååå å åååååååååååååååååäÝÙÓ¿© ƒ>0Rtt/——<¼¼KÿÿdÿÿfÿÿgÿÿjÿÿlÿÿnÿÿoÿÿsÿÿuûûvD‚ÿÿø~! ? Njƒ¢ÅÕÜàçææ å åååååååååååååååçççÚÔÁ¹«ž )’HCY w†-“Ÿ7´ºB××QãâWïîZõõ\ÿÿ`ÿÿaÿÿaÿÿbÿÿcÿÿeÿÿgÿÿjÿÿmÿÿoÿÿqûûtžžJ þ‚ÿ¢ÿ÷~  : Nv„ŸµÇÒØèèçæ å åååååååååååååååæåàÝÖÆ ©z :†TM‰ 2”©6¯»?ÆÊHÜÙPìêUôóWÿÿ\ÿÿ[ÿÿZÿÿZÿÿZÿÿZÿÿ[ÿÿ\ÿÿ]ÿÿ^ÿÿ`ÿÿbÿÿcÿÿfÿÿhÿÿlÿÿnþþp½½V&&‚ÿ±ÿô~ Ai|¤·ÚÞàåååå å åååååååååååååååååäãáÙ°‹q1zG~ct…,’™6¶»CØÙOôóXø÷YúùYÿÿZÿÿYÿÿYÿÿXÿÿWÿÿVÿÿVÿÿUÿÿUÿÿUÿÿVÿÿVÿÿWÿÿWÿÿYÿÿZÿÿ[ÿÿ^ÿÿ`ÿÿbÿÿdÿÿgÿÿkÿÿmääd99þ‚ÿÃÿú~ . G Zl’§Ýáâäååå å ååååååååååååååæçèâ×ÊÄ ´¦” 3ŽLv‡h|(y~.­¯@Ö×PðïZõõ[ø÷ZýýZÿÿZÿÿYÿÿXÿÿXÿÿWÿÿVÿÿUÿÿTÿÿSÿÿRÿÿRÿÿRÿÿRÿÿRÿÿRÿÿQÿÿRÿÿRÿÿSÿÿTÿÿVÿÿXÿÿYÿÿ[ÿÿ^ÿÿ`ÿÿcÿÿfÿÿkïïi>>þ‚ÿÉÿý~ $ Cs’¢ÆÏØàéççå å åååååååååååååææçãÙÐÈ ²§#‰ -‹M‘t˜+„œ1¡~±;½ÄEØÔQãàTïíWûúZÿÿ[ÿÿZÿÿYÿÿXÿÿWÿÿVÿÿUÿÿUÿÿTÿÿSÿÿSÿÿRÿÿRÿÿPÿÿOÿÿOÿÿNÿÿNÿÿNÿÿMÿÿNÿÿNÿÿNÿÿOÿÿOÿÿQÿÿRÿÿSÿÿUÿÿXÿÿZÿÿ]ÿÿ`ÿÿcÿÿfïïepp0û‚ÿÕÿø~ ] ÌÚçææåå åååååååååååååååååæææǤwn@kŽ'Ž›4¨´>¹ÁDæäTëéUô~óXýü[ÿÿ\ÿÿZÿÿYÿÿXÿÿXÿÿWÿÿVÿÿVÿÿUÿÿTÿÿSÿÿRÿÿRÿÿQÿÿPÿÿPÿÿOÿÿOÿÿNÿÿMÿÿLÿÿLÿÿKÿÿKÿÿKÿÿKÿÿKÿÿKÿÿKÿÿLÿÿMÿÿMÿÿNÿÿPÿÿRÿÿTÿÿWÿÿYÿÿ\ÿÿ`ÿÿ cüüf››@ ‚ÿÒÿý~ KŸ#áæååå ååååååååååååæææÞÚξ «”ˆ AT|qm,•’8¾¼FíìXÿÿ^ÿÿ\ÿÿ[ÿÿZÿÿYÿÿ~XÿÿXÿÿWÿÿWÿÿVÿÿUÿÿUÿÿTÿÿSÿÿRÿÿRÿÿQÿÿPÿÿOÿÿOÿÿOÿÿNÿÿMÿÿLÿÿLÿÿKÿÿJÿÿJÿÿHÿÿHÿÿHÿÿGÿÿGÿÿFÿÿFÿÿFÿÿGÿÿGÿÿHÿÿIÿÿIÿÿKÿÿLÿÿNÿÿQÿÿSÿÿVÿÿYÿÿ\ÿÿ`ÿÿc®®F‚ÿÕÿý~[´ Þæåå ååååååååççéßÕÈ»¬ž '’A’P‘z.”£7³»BÓÓOßÝTíìWôóXÿÿ\ÿÿZÿÿYÿÿXÿÿXÿÿWÿÿVÿÿ~VÿÿUÿÿTÿÿSÿÿSÿÿRÿÿRÿÿQÿÿPÿÿOÿÿOÿÿNÿÿMÿÿMÿÿLÿÿKÿÿKÿÿJÿÿIÿÿHÿÿGÿÿGÿÿFÿÿEÿÿDÿÿDÿÿDÿÿCÿÿCÿÿCÿÿBÿÿBÿÿBÿÿCÿÿCÿÿEÿÿFÿÿHÿÿIÿÿKÿÿMÿÿPÿÿSÿÿVÿÿZÿÿ]þþaÅÅN!! ‚ÿØÿþ~ Pµ ßæå åååååååááÝÍ « šs*M‹zš-–©7°½@ÊÍJÞÚQêèUðïVÿÿ\ÿÿ[ÿÿZÿÿXÿÿXÿÿWÿÿVÿÿVÿÿUÿÿTÿÿSÿÿSÿÿRÿ~ÿRÿÿQÿÿPÿÿOÿÿOÿÿNÿÿNÿÿMÿÿLÿÿKÿÿKÿÿJÿÿIÿÿIÿÿHÿÿGÿÿFÿÿFÿÿEÿÿDÿÿDÿÿCÿÿBÿÿAÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ?ÿÿ?ÿÿ?ÿÿ?ÿÿ?ÿÿ@ÿÿAÿÿAÿÿBÿÿDÿÿFÿÿIÿÿJÿÿMÿÿPÿÿSÿÿWÿÿZþþ_ßßV::þ‚ÿÛÿ~)£!áåå åååååàÍžw%dHo*Œ5¶¸CÊÌJùù[ûúZüüZþþZÿÿZÿÿYÿÿXÿÿXÿÿWÿÿVÿÿVÿÿUÿÿTÿÿSÿÿSÿÿRÿÿRÿÿQÿÿPÿÿPÿ~ÿOÿÿNÿÿNÿÿMÿÿLÿÿLÿÿKÿÿJÿÿJÿÿIÿÿHÿÿGÿÿGÿÿFÿÿEÿÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ;ÿÿ;ÿÿ;ÿÿ<ÿÿ<ÿÿ=ÿÿ>ÿÿ?ÿÿAÿÿBÿÿEÿÿHÿÿJÿÿMÿÿQÿÿTÿÿXÿÿ\ììYVV!þ‚ÿÛÿ~m#Üåå åååçߺ’8gny*¡¥>ÝÜTîî[õôZüü[ÿÿ[ÿÿYÿÿYÿÿXÿÿWÿÿVÿÿUÿÿUÿÿTÿÿSÿÿSÿÿRÿÿQÿÿQÿÿPÿÿPÿÿOÿÿOÿÿNÿÿMÿÿLÿÿKÿ~ÿKÿÿJÿÿJÿÿIÿÿHÿÿGÿÿFÿÿFÿÿEÿÿDÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ:ÿÿ;ÿÿ<ÿÿ=ÿÿ@ÿÿAÿÿEÿÿHÿÿKÿÿNÿÿRÿÿUÿÿZøø[hh'‚ÿÞÿû~(–!âåååååÛ¡n e~&°±BãâVüü]ÿÿ]ÿÿZÿÿYÿÿXÿÿWÿÿUÿÿUÿÿTÿÿSÿÿRÿÿQÿÿQÿÿPÿÿOÿÿOÿÿNÿÿNÿÿMÿÿLÿÿLÿÿKÿÿKÿÿJÿÿIÿÿHÿÿGÿÿGÿ~ÿFÿÿEÿÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ7ÿÿ6ÿÿ6ÿÿ6ÿÿ5ÿÿ5ÿÿ5ÿÿ5ÿÿ6ÿÿ7ÿÿ8ÿÿ9ÿÿ:ÿÿ=ÿÿ?ÿÿAÿÿEÿÿHÿÿKÿÿOÿÿSÿÿWùùZ˜˜8 ‚ÿÛÿþ~ 1!Åäå åååã¦Tƒˆ2ÞÝSûû\ÿÿ\ÿÿZÿÿYÿÿWÿÿVÿÿTÿÿSÿÿRÿÿQÿÿPÿÿPÿÿOÿÿNÿÿMÿÿMÿÿMÿÿKÿÿKÿÿJÿÿIÿÿHÿÿHÿÿGÿÿFÿÿFÿÿEÿÿDÿÿDÿÿCÿ~ÿBÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ>ÿÿ<ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ3ÿÿ2ÿÿ2ÿÿ1ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ1ÿÿ3ÿÿ4ÿÿ4ÿÿ5ÿÿ8ÿÿ:ÿÿ<ÿÿ>ÿÿAÿÿEÿÿIÿÿLÿÿPÿÿTÿÿZ¶¶Cþ‚ÿáÿþ~ J!ÕåååååÇhsw,ççWþþ]ÿÿ[ÿÿYÿÿWÿÿUÿÿSÿÿRÿÿQÿÿOÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿHÿÿGÿÿFÿÿEÿÿEÿÿCÿÿCÿÿBÿÿBÿÿAÿÿAÿÿ@ÿÿ?ÿ~ÿ>ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ8ÿÿ7ÿÿ7ÿÿ6ÿÿ5ÿÿ5ÿÿ3ÿÿ2ÿÿ1ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ,ÿÿ+ÿÿ,ÿÿ,ÿÿ,ÿÿ-ÿÿ.ÿÿ/ÿÿ2ÿÿ3ÿÿ5ÿÿ8ÿÿ;ÿÿ=ÿÿAÿÿEÿÿIÿÿMÿÿRÿÿW½½C þ‚ÿáÿþ~_!×ååååÚ’Fe·µGõõ[ÿÿ\ÿÿYÿÿWÿÿTÿÿSÿÿQÿÿPÿÿNÿÿMÿÿKÿÿJÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿ~ÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ7ÿÿ6ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ-ÿÿ,ÿÿ,ÿÿ+ÿÿ*ÿÿ*ÿÿ*ÿÿ)ÿÿ(ÿÿ(ÿÿ(ÿÿ(ÿÿ)ÿÿ)ÿÿ*ÿÿ+ÿÿ-ÿÿ/ÿÿ2ÿÿ4ÿÿ7ÿÿ;ÿÿ=ÿÿAÿÿFÿÿJÿÿOÿÿSÚÚLFFþ‚ÿáÿý~Z Öå åååÔh}†0éèWÿÿ]ÿÿZÿÿWÿÿUÿÿSÿÿPÿÿOÿÿMÿÿKÿÿJÿÿIÿÿHÿÿFÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ~9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ,ÿÿ,ÿÿ+ÿÿ*ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ&ÿÿ&ÿÿ%ÿÿ%ÿÿ%ÿÿ%ÿÿ%ÿÿ%ÿÿ&ÿÿ'ÿÿ(ÿÿ*ÿÿ,ÿÿ0ÿÿ3ÿÿ7ÿÿ;ÿÿ>ÿÿAÿÿGÿÿKÿÿPúúVNN‚ÿÞÿþ~ ?#åå åååÉG ··Gûû]ÿÿ[ÿÿWÿÿUÿÿSÿÿPÿÿNÿÿLÿÿJÿÿIÿÿHÿÿFÿÿEÿÿCÿÿCÿÿBÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿ~ÿ5ÿÿ3ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ,ÿÿ+ÿÿ+ÿÿ*ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ%ÿÿ$ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ!ÿÿ!ÿÿ ÿÿ ÿÿ!ÿÿ!ÿÿ!ÿÿ"ÿÿ$ÿÿ&ÿÿ'ÿÿ+ÿÿ.ÿÿ2ÿÿ5ÿÿ;ÿÿ>ÿÿBÿÿHÿÿMòòOaa"‚ÿÞÿ~ :Éå ååå©5`½½Iþþ]ÿÿZÿÿVÿÿSÿÿQÿÿOÿÿMÿÿJÿÿHÿÿGÿÿEÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ3ÿ~ÿ2ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ(ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ%ÿÿ$ÿÿ#ÿÿ#ÿÿ"ÿÿ!ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ"ÿÿ$ÿÿ&ÿÿ)ÿÿ.ÿÿ2ÿÿ6ÿÿ;ÿÿ>ÿÿDÿÿI÷÷L••1 þ‚ÿáÿ~ ³åååå­CaÒÑOÿÿ]ÿÿYÿÿVÿÿSÿÿPÿÿMÿÿKÿÿIÿÿGÿÿDÿÿCÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ2ÿÿ0ÿÿ/ÿ~ÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ#ÿÿ"ÿÿ!ÿÿ!ÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ"ÿÿ%ÿÿ)ÿÿ-ÿÿ2ÿÿ7ÿÿ;ÿÿ?ÿÿEÿÿK±±7 þ‚ÿáÿþ~”æåååÒ6IààTÿÿ\ÿÿYÿÿUÿÿRÿÿOÿÿLÿÿJÿÿHÿÿEÿÿBÿÿAÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ+ÿ~ÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ"ÿÿ!ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ"ÿÿ%ÿÿ)ÿÿ.ÿÿ2ÿÿ7þþ<þþAýýGÉÉ= þ‚ÿÞÿ~gâååæÅS ÄÄKþþ]ÿÿYÿÿUÿÿRÿÿNÿÿKÿÿIÿÿGÿÿCÿÿAÿÿ@ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ5ÿÿ3ÿÿ1ÿÿ/ÿÿ/ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿ~ÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþööïïââÕÕ#µµ-žž4:ZZS33eZþ‚ÿÞÿþ~ Îå ååÙj ´´Dÿÿ^ÿÿYÿÿUÿÿRÿÿNÿÿKÿÿIÿÿFÿÿCÿÿ@ÿÿ?ÿÿ>ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ3ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ+ÿÿ*ÿÿ(ÿÿ'ÿ~ÿ%ÿÿ$ÿÿ#ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþôôììÝÝÛÛ°°––"||,[[KHH]++~!!±ÈØèÝa‚ÿÞÿþ~ ‡ååå円Œ3ûû]ÿÿZÿÿVÿÿRÿÿOÿÿKÿÿIÿÿFÿÿBÿÿ@ÿÿ?ÿÿ>ÿÿ<ÿÿ;ÿÿ:ÿÿ8ÿÿ8ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿÿ'ÿÿ%ÿ~ÿ%ÿÿ#ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþýýüüúú¹¹££ ttTT7BBP„ ·Îæðõýÿÿÿÿù‚ÿÞÿû~ H ÙåååÃN\ïî[ÿÿ[ÿÿVÿÿSÿÿPÿÿKÿÿIÿÿEÿÿBÿÿ?ÿÿ>ÿÿ=ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ4ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ+ÿÿ*ÿÿ)ÿÿ'ÿÿ%ÿÿ$ÿ~ÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýýööññë븸²²’’hh5AANip»Ðüÿÿÿÿÿÿÿÿÿÿÿÿÿþœ ‚ÿÛÿþ~ žæ ååÚX ÒÒPþþ\ÿÿXÿÿTÿÿPÿÿMÿÿJÿÿFÿÿCÿÿ@ÿÿ>ÿÿ<ÿÿ;ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ/ÿÿ-ÿÿ-ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ%ÿÿ$ÿ~ÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿîîãã××½½««‹‹(ww5OOT55h {² ¹Ùçñüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿû½ þ‚ÿÛÿþ~ ?Ùååæ–…0þþ^ÿÿYÿÿUÿÿRÿÿNÿÿJÿÿGÿÿCÿÿ@ÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ,ÿÿ*ÿÿ*ÿÿ(ÿÿ(ÿÿ%ÿÿ$ÿ~ÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿþþõõòòëëÍͱ±‡‡ssKKO77k""¨ º×áïøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþøóëݲŠ%þ‚ÿØÿ~ªæ ååÏ8cðïZÿÿ[ÿÿWÿÿSÿÿOÿÿKÿÿHÿÿDÿÿAÿÿ?ÿÿ>ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ5ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ.ÿÿ-ÿÿ.ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ(ÿÿ&ÿ~ÿ$ÿÿ#ÿÿ!ýýûûùùçç··~~EEI22Z }ž½åøüýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýûø軧€T<þ‚ÿØÿþ~#!æåå厜 ;þþ]ÿÿXÿÿTÿÿQÿÿLÿÿIÿÿEÿÿAÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ.ÿÿ.ö÷+îï&ââ!Ýݳ~³'žž+ŠŠ1\\KCCYp… ·ßêõøþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûíàÚµ§‰lH õ‚ÿÌÿ~€å ååÞ7làÞUÿÿ[ÿÿVÿÿRÿÿNÿÿJÿÿGÿÿCÿÿ@ÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ4ÿÿ3ÿÿ0ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0÷ø.êë,Ýà+ÈÐ%·®’†y”ctL3/0z'm'†³ÆØèðýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûïæݾxoT0% õ‚ÿºÿþ~¸ååå¸zƒ/ûû]ÿÿYÿÿTÿÿPÿÿLÿÿIÿÿEÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ7ÿÿ5ÿÿ3ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÖÕ(]_}mDˆ ”ÀÑêïŒnþXÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÌ°{hG- õ‚ÿ¥ÿþ~ ?Ùååã cÍÌOÿÿ\ÿÿVÿÿRÿÿNÿÿKÿÿGÿÿCÿÿ@ÿÿ>ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0þþ/ãã*‚(mtzÙÜèýÛçþ&4ÿÿÿÿÿ±QñCÿÿÿÿÿÿÿÿÿÿþòîåθ–ŽG1ì‚ÿ™ÿbzå åå×Rd÷ö]ÿÿZÿÿUÿÿQÿÿMÿÿJÿÿFÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ7ÿÿ5ÿÿ3ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0þþ0ÝÝ)giH°±¶õöøýÿLöúÿ[jÿÿÿÿÿ¸HìÿÿÿþòêÚϱ–|VD#ø‚ÿ‚ÿýÿþ_§æå笞<þþ\ÿÿXÿÿTÿÿOÿÿKÿÿHÿÿDÿÿ@ÿÿ?ÿÿ<ÿÿ:ÿÿ8ÿÿ9ÿÿ6ÿÿ4ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0þþ/ÝÝ)}}GÐÓàýýþ÷ÿ4”ŸÿÿÿþúÔ)$Òñ³žsYH$ ø‚ÿ‚ÿèÿþY&ÌååèqØØRÿÿ[ÿÿVÿÿRÿÿMÿÿJÿÿGÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ5ÿÿ4ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0îï,ll1Ø×Ùòÿ øËÖò¼ª†W=ø‚ÿ‚ÿÓÿþ\ HÚååØ)jûû]ÿÿZÿÿUÿÿQÿÿLÿÿIÿÿEÿÿAÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ7ÿÿ4ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0‰€™!û±´ÿûüûÿþð ¡©IIM ö‚ÿ‚ÿÁÿþ_eç ååË_‚$ýý]ÿÿYÿÿTÿÿPÿÿKÿÿIÿÿDÿÿAÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0éé,^íÿÿ’šÿñöþëþg û‚ÿ‚ÿ¯ÿeyèå宊—4ÿÿ\ÿÿWÿÿSÿÿOÿÿJÿÿGÿÿCÿÿ@ÿÿ>ÿÿ;ÿÿ9ÿÿ9ÿÿ7ÿÿ6ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0†‡¸ÿÿÿëZl_SYþþ‚ÿ‚ÿ©ÿe£çå欳¿Cÿÿ\ÿÿWÿÿSÿÿNÿÿJÿÿFÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0êë-X7 úÿÿÿ— þ‚ÿ‚ÿ¦ÿe«çåæ µ¼Cÿÿ[ÿÿVÿÿRÿÿMÿÿJÿÿFÿÿBÿÿ>ÿÿ=ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0×Ù*…þÿÿøB‚ÿ‚ÿ£ÿ` Úååç ‘ ÒÏOÿÿ[ÿÿVÿÿRÿÿMÿÿJÿÿFÿÿAÿÿ?ÿÿ=ÿÿ:ÿÿ9ÿÿ7ÿÿ6ÿÿ3ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0º·"ª ÿÿÿãü‚ÿ‚ÿ£ÿ]!àååç'”ÝÙTÿÿ[ÿÿUÿÿRÿÿMÿÿIÿÿEÿÿAÿÿ?ÿÿ<ÿÿ:ÿÿ9ÿÿ7ÿÿ5ÿÿ3ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0º²"Àÿÿÿ»þ ‚ÿ‚ÿ ÿb!àååç'”ÝÙTÿÿ[ÿÿUÿÿQÿÿMÿÿIÿÿEÿÿAÿÿ?ÿÿ;ÿÿ:ÿÿ9ÿÿ7ÿÿ5ÿÿ3ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0»º*Á®§ÿßßÿßßÿßß¼¦¦ ‚ÿ‚ÿ ÿS!àååç'”ÝÙTÿÿ[ÿÿUÿÿQÿÿMÿÿIÿÿEÿÿAÿÿ?ÿÿ;ÿÿ:ÿÿ8ÿÿ7ÿÿ5ÿÿ3ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0¸¸(³³¬øÿþÊþþ‚ÿ‚ÿ£ÿS!àååç&”ÝÙTÿÿ[ÿÿUÿÿRÿÿMÿÿIÿÿEÿÿAÿÿ?ÿÿ<ÿÿ:ÿÿ9ÿÿ7ÿÿ5ÿÿ3ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÑÒ'••‹øÿþó''.þ‚ÿ‚ÿ£ÿSÄæåç“ ÀÀHÿÿ[ÿÿVÿÿRÿÿMÿÿJÿÿFÿÿAÿÿ?ÿÿ=ÿÿ:ÿÿ9ÿÿ7ÿÿ6ÿÿ3ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0çç,]]8þüûÿþüjjqþ‚ÿ‚ÿ£ÿS£çå檳¾Cÿÿ[ÿÿVÿÿRÿÿMÿÿJÿÿFÿÿBÿÿ?ÿÿ=ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0üü/ssþÔøÿÊÄÇ(û‚ÿ‚ÿ©ÿS•çå梞§<ÿÿ\ÿÿWÿÿSÿÿOÿÿJÿÿFÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÚÚ)þ`þöýÿòûþg|¼ ü‚ÿ‚ÿ©ÿþijé ååÆy‘.þþ]ÿÿXÿÿSÿÿPÿÿKÿÿGÿÿCÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ7ÿÿ5ÿÿ2ÿÿ/ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0vv µ´µÿÈØÿ2BÿþÅ0‚Ôþ‚ÿÛÿþnWá ååÒEyüü]ÿÿYÿÿTÿÿPÿÿLÿÿHÿÿDÿÿ@ÿÿ>ÿÿ<ÿÿ:ÿÿ8ÿÿ7ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÜÜ)jY/Ù&ÿÿÿÿä˜X<<õW~XXW++WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW"WWWWWWWWW@ü‚ÿäÿþn 8Óååái øø]ÿÿZÿÿUÿÿRÿÿMÿÿIÿÿEÿÿAÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0þþ/»»"wõþÿÿÿûðÁÄõï~ððïttïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïïï+ïïïïïïïïïçÉŸUû‚ÿíÿþn½ååè ‹¸¹Fÿÿ\ÿÿWÿÿSÿÿNÿÿJÿÿGÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ8ÿÿ8ÿÿ6ÿÿ4ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÁÁ%Nßþÿÿÿ7Bÿíðòÿ~zzÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ1ÿÿÿÿÿÿÿÿÿÿÿþé˜Eþ‚ÿðÿn ’æåæÀw{-üü]ÿÿYÿÿTÿÿPÿÿLÿÿHÿÿCÿÿ@ÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ6ÿÿ4ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0þþ0ÌÌ'iG ™ãþÿjwÿúýòÿ~zzÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ:ÿÿÿÿÿÿÿÿÿÿÿÿÿþóËc‚ÿöÿþv[à ååá)WééZÿÿ[ÿÿVÿÿQÿÿMÿÿJÿÿEÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ:ÿÿ8ÿÿ9ÿÿ7ÿÿ5ÿÿ4ÿÿ2ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0åæ*¡œg8 ÉyŠääåððñððñððñððýñ~ttññññññññññññññññññññññññññññññññññññññññññ:ñññññòüÿÿÿÿÿÿÿÿÿõÅeþ‚ÿùÿþ~)Òåå姩@ÿÿ]ÿÿXÿÿSÿÿOÿÿKÿÿGÿÿCÿÿ@ÿÿ>ÿÿ<ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ7ÿÿ6ÿÿ4ÿÿ4ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ.þþ,ôô)àŽrr*‡‡O‡‡N‡‡N‡‡MˆˆMddLE~ELEEKEEKEEKEEKEEKEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEEJEE9JEEJEEJEEJ00Kj™Îúÿÿÿÿÿÿÿÿù·5û‚ÿÿÿþ~ ˜å ååÐSkññZÿÿZÿÿTÿÿQÿÿMÿÿIÿÿFÿÿBÿÿ?ÿÿ>ÿÿ<ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ5ÿÿ4ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ.ÿÿ,ÿÿ+ÿÿ)þþ'ûû&úú%úú"úú!úúúúúúú~úúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúúú?úúúúúúøøïï»» „„UU))W¢Úúÿÿÿÿÿþõ‹þ‚ÿ~ÿÿXæååãw ÄÃJÿÿ\ÿÿWÿÿSÿÿOÿÿKÿÿHÿÿDÿÿAÿÿ?ÿÿ=ÿÿ<ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ1ÿÿ0ÿÿ0ÿÿ.ÿÿ,ÿÿ+ÿÿ)ÿÿ'ÿÿ&ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿGÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿóóÞÞ  YY,i¼íþÿÿÿÿú½?þ†ÿþ~!Øååå°k})úú]ÿÿZÿÿUÿÿQÿÿMÿÿJÿÿGÿÿBÿÿ@ÿÿ>ÿÿ=ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ3ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ'ÿÿ%ÿÿ#ÿÿ!ÿÿÿÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿööÌÌ ƒƒþ!N¶üÿÿÿÿÿàa†ÿ~näååàjÄÃJÿÿ\ÿÿXÿÿTÿÿPÿÿLÿÿIÿÿFÿÿBÿÿ@ÿÿ>ÿÿ=ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ/ÿÿ/ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ&ÿÿ%ÿÿ"ÿÿ!ÿÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿHÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿçç}} VÕýÿÿÿÿÿn þ‰ÿþ~ÂååæÂE^ôô\ÿÿZÿÿVÿÿSÿÿOÿÿKÿÿIÿÿEÿÿBÿÿ@ÿÿ>ÿÿ=ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ2ÿÿ0ÿÿ/ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ'ÿÿ%ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿHÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúÉÉJJ& ëÿÿÿÿ÷”þŒÿý~rãååã‚‘’7ûû\ÿÿYÿÿUÿÿRÿÿNÿÿKÿÿHÿÿEÿÿBÿÿ@ÿÿ>ÿÿ=ÿÿ;ÿÿ:ÿÿ:ÿÿ8ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ)ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ~!ÿÿ ÿÿ ÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿJÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿì쌌Mßüÿÿÿøš þŒÿþ~!¸å ååä[ ÉÇMÿÿ]ÿÿXÿÿTÿÿQÿÿNÿÿJÿÿHÿÿEÿÿBÿÿ@ÿÿ>ÿÿ>ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ9ÿÿ8ÿÿ5ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*õõ'••††þþ&ÿÿ&ÿ~ÿ%ÿÿ%ÿÿ$ÿÿ$ÿÿ$ÿÿ$ÿÿ$ÿÿ$ÿÿ$ÿÿ$ýý$Éɪªªªªªªªªªªªªªªª¿¿ÿÿ$ÿÿ$ÿÿ$ÿÿ$ÿÿ$ÿÿ$üü$¬¬||ÛÛÿÿ#ÿÿ#ÿÿ#ÿÿ#ÿÿ"ÿÿ"ÿÿ"ÿÿ"ÿÿ!ÿÿ!ÿÿ ÿÿK ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÅÅ77 ½ÿÿÿÿþŽþÿý~QàåååºGeèçWÿÿ\ÿÿWÿÿTÿÿQÿÿMÿÿJÿÿIÿÿEÿÿBÿÿAÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ8ÿÿ7ÿÿ5ÿÿ2ÿÿ0ÿÿ0ÿÿ.ÿÿ.ÿÿ-ÖÖ$""88 øø)úú(úú~(úú(úú(úú(üü(ÿÿ)ÿÿ(ÿÿ(ÿÿ(ÿÿ(óó&EE ddÿÿ(ÿÿ(ÿÿ(ÿÿ(ÿÿ(ÿÿ(òò%@@ ÏÏ ÿÿ'ÿÿ'ÿÿ&ÿÿ&ÿÿ&ÿÿ&ÿÿ&ÿÿ&ÿÿ%ÿÿ%ÿÿ$ÿÿ$Mÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþääFF%£úÿÿÿöiŒÿþ~ ¤åååå”cp&ññ[ÿÿ[ÿÿWÿÿSÿÿPÿÿMÿÿKÿÿIÿÿFÿÿCÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ3ÿÿ1ÿÿ1ÿÿ/ºº" :: :: :: :~: :: :: ŽŽýý,ÿÿ,ÿÿ,ÿÿ,ÿÿ,öö+••‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚ÀÀ!ÿÿ,ÿÿ,ÿÿ,ÿÿ,ÿÿ,ÿÿ+èè'//ãã%ÿÿ*ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ(ÿÿ)ÿÿ(ÿÿ(ÿÿ'ÿÿ'ÿÿ'ÿÿK'ÿÿ%ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿããii–úÿÿÿçPûÿþk& Ñå ååàŒ„„2üü^ÿÿ[ÿÿWÿÿSÿÿQÿÿNÿÿKÿÿIÿÿGÿÿDÿÿBÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ4••ì~‘‘ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0üü/öö-öö-öö-öö-öö-öö-öö-öö-öö-ýý/ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ/ÎÎ%JJ íí*öö+öö+öö+öö*öö*þþ+ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ)ÿÿ)ÿÿ(ÿÿ(ÿIÿ(ÿÿ'ÿÿ'ÿÿ%ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿòòaa¦ÿÿÿÿØþŒÿþ~ J Ùåååä]•˜8ùù\ÿÿ[ÿÿWÿÿTÿÿRÿÿOÿÿLÿÿKÿÿIÿÿFÿÿDÿÿCÿÿAÿÿ?ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ9__»»)øø6øø6øø6øø6øø5ùù5þþ6ÿÿ7ÿÿ7ÿÿ7ÿÿ7ÿÿ7šš é""××-ÿÿ5ÿÿ5ÿÿ5ÿÿ4ÿÿ4ÿÿ3™™ìkíí*ÿÿ.ÿÿ.ÿÿ.ÿÿ-ÿÿ,ÿÿ,ÿÿ,ÿÿ+ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ&ÿÿ$ÿÿ#ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ<<¸þÿÿÿ» þŒÿ~ yáåååÚo†3ðïZÿÿ\ÿÿXÿÿUÿÿSÿÿPÿÿMÿÿKÿÿJÿÿHÿÿFÿÿDÿÿBÿÿAÿÿ@ÿÿ?ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ<ÿÿ;þþ:.. !!)) )) )) )) )) @I@ëë5ÿÿ:ÿÿ:ÿÿ:ÿÿ:ÿÿ:””">>>>>>>>>>>>>>>>ggïï6ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ9þþ8hhþ~11 >>>> >> >> >> mmöö-ÿÿ.ÿÿ.ÿÿ.ÿÿ.ÿÿ.ÿÿ.ÿÿ.ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ'ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÚÚ@@/Òÿÿÿújÿ~Šåååå× …cj&òò]þþ\ÿÿYÿÿVÿÿSÿÿQÿÿOÿÿMÿÿKÿÿIÿÿHÿÿFÿÿEÿÿDÿÿBÿÿBÿÿAÿÿ@ÿÿ?ÿÿ?ÿÿ>ÿÿ>ÿÿ>êê8 <~<ýý<ÿÿ=ÿÿ=ÿÿ=ÿÿ=þþ=øø<öö;öö;öö;öö;öö;öö;öö;öö:ûû;ÿÿ<ÿÿ<ÿÿ<ÿÿ<ÿÿ;ÿÿ;óó7BBÝÝ1ÿÿ8ÿÿ8ÿÿ6ÿÿ4ÿÿ2ÿÿ1ÿÿ1ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ/ÿÿ/ÿÿ/ÿÿ/ÿÿQ/ÿÿ/ÿÿ.ÿÿ.ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ'ÿÿ$ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¿¿NúÿÿÿÒ(þÿþ~µååååãO`ÛÚRÿÿ]ÿÿZÿÿXÿÿTÿÿSÿÿQÿÿOÿÿMÿÿKÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿCÿÿCÿÿBÿÿBÿÿB½½0 ‰‰#ÿÿAÿÿAÿÿAÿÿAÿÿAÿÿAÿÿAÿÿAÿ~ÿAÿÿAÿÿAÿÿAââ:]]DDDDDDDDDDDDDDDD´´-ÿÿ@ÿÿ@ÿÿ@ÿÿ?ÿÿ?ÿÿ>ÛÛ4&& óó7ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ4ÿÿ3ÿÿ3ÿÿ2ÿÿ1ÿÿ1ÿÿ1ÿÿ1ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿK0ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ+ÿÿ)ÿÿ'ÿÿ%ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿûûŽŽ ûÿÿü‹þÿû~¥äåååã°$] £¢=ññ[ÿÿ]ÿÿYÿÿWÿÿTÿÿSÿÿQÿÿPÿÿNÿÿLÿÿKÿÿKÿÿJÿÿIÿÿHÿÿHÿÿGÿÿFÿÿFÿÿF’’'¸¸2ÿÿFÿÿFÿÿFÿÿFÿÿFÿÿFÿÿFÿÿFÿÿFÿ~ÿFÿÿFÿÿFÍÍ8-- !! !! !! !! !! !! !! !! ÈÈ6ÿÿEÿÿEÿÿDÿÿDÿÿCÿÿBÁÁ1 NNøø<ÿÿ<ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ9ÿÿ7ÿÿ3ÿÿ2ÿÿ3ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿH1ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ,ÿÿ)ÿÿ(ÿÿ%ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿööJJ!Ìÿÿÿä0þ‰ÿþ~#¦ãå ååæ΂Yf"ËËMûû]ÿÿ[ÿÿYÿÿWÿÿUÿÿSÿÿRÿÿQÿÿPÿÿNÿÿMÿÿMÿÿLÿÿLÿÿKÿÿKÿÿKÿÿKÜÜA½½8ððFÿÿJÿÿJÿÿJÿÿJÿÿJÿÿJÿÿJÿÿJÿÿJÿÿJÿ~ÿJÿÿJôôG××?××?××?××?××?××?××?××?××?øøHÿÿIÿÿIÿÿHÿÿHÿÿGÿÿFëë?ºº1ÔÔ6þþ@ÿÿ>ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ7ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ2ÿÿ3ÿÿH2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ'ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿþþËË\ðÿÿý˜þ‰ÿþ~ !äå åååä¹[ {}/ëëYÿÿ]ÿÿ[ÿÿZÿÿXÿÿVÿÿUÿÿSÿÿRÿÿRÿÿQÿÿPÿÿPÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿ~ÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿOÿÿNÿÿNÿÿMÿÿLÿÿLÿÿKÿÿIÿÿHÿÿFÿÿDÿÿBÿÿAÿÿ?ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ5ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ5ÿÿ4ÿÿE3ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ)ÿÿ'ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿýý}}´ÿÿÿü&þ†ÿþ~w Óåååååâ¨T{‡/ÉÈKóòZÿÿ^ÿÿ\ÿÿZÿÿYÿÿWÿÿVÿÿVÿÿUÿÿUÿÿUÿÿTÿÿTÿÿTÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿ~ÿSÿÿSÿÿSÿÿSÿÿSÿÿSÿÿTÿÿTÿÿTÿÿSÿÿSÿÿSÿÿRÿÿQÿÿPÿÿOÿÿNÿÿLÿÿJÿÿHÿÿFÿÿCÿÿAÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ4ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ4ÿÿ4ÿÿ5ÿÿE4ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ+ÿÿ)ÿÿ'ÿÿ$ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿ××**Køÿÿÿ™ƒÿþ~ G ¿çå åååæÙ°{ Mt˜ž:ÒÐPèçXûû]ÿÿ]ÿÿ\ÿÿ[ÿÿZÿÿZÿÿYÿÿYÿÿXÿÿXÿÿYÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿ~ÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿXÿÿWÿÿVÿÿVÿÿUÿÿTÿÿSÿÿQÿÿOÿÿMÿÿKÿÿHÿÿFÿÿCÿÿAÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ4ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ4ÿÿ5ÿÿ4ÿÿE4ÿÿ2ÿÿ0ÿÿ/ÿÿ-ÿÿ*ÿÿ(ÿÿ&ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿúúzzÅÿÿÿÖ"ƒÿ~""Þäå åååæãÏ› õõ<õõ;õõ9õõ9õõ8øø9ýý8ÿÿ5ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ4ÿÿB5ÿÿ3ÿÿ2ÿÿ0ÿÿ.ÿÿ-ÿÿ*ÿÿ(ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÐÐeúÿÿöVþ‚ÿùÿ~ ?°!âåå ååååååå⪀nnnnnnnnnnnnnnnnnnnnnnnnnn@nnnnnnnnnnnnnnnnnnnnoftfõtnkkinlKxs"±®&ññ1þþ2ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ2ÿÿ1ÿÿ/ÿÿ.ÿÿ+ÿÿ)ÿÿ&ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿ÷÷VVâÿÿÿ˜‚ÿùÿû~_±!ßæåå åååååææçççççççççççççççççççççççççççç:çççççççççççççççççç'é'ÞüÞõÿþükïÐÚØ3™ k5 ž™ïð0ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ2ÿÿ1ÿÿ/ÿÿ/ÿÿ,ÿÿ)ÿÿ'ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿþþ¬¬–ÿÿÿÒþ‚ÿöÿû~V¯"Üåååå åååååååååååååååååååååååååååååååååå4åååååååååååååååå'è'ÝûÝñÿj½Åÿÿá” nUãã-þþ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ2ÿÿ/ÿÿ/ÿÿ.ÿÿ*ÿÿ(ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿóóYôÿÿìGþ‚ÿðÿý~ 5|"Å$ã ååååååå å å å ååååååååååååååååååååååååååå.åååååååååååååå'è'ÝûÝñÿj—ÿÿÿþÈd@ Þß,ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ+ÿÿ)ÿÿ&ÿÿ$ÿÿ ÿÿÿÿÿÿÿÿÿÿýýZZ1Þÿÿÿqþ‚ÿêÿý~ 8|ž"È ÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈÈ*ÈÈÈÈ È ÈÈÈÈÈÈÈ"Ë"ÀÚÀõÝqÜÖ×éNSþÿÿÿÿÖjD áâ+ÿÿ0ÿÿ0ÿÿ0ÿÿ1ÿÿ2ÿÿ2ÿÿ2ÿÿ/ÿÿ0ÿÿ/ÿÿ,ÿÿ)ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿ••½ÿÿÿµ‚ÿáÿû~!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! $ õ%q(##= “êþÿÿü¬bdqr$ûû0ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ2ÿÿ0ÿÿ/ÿÿ/ÿÿ-ÿÿ*ÿÿ(ÿÿ&ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿµµšÿÿÿâ‚ÿ‚ÿ¬ÿAåþÿ0ÿ¶Çùô÷þuS»»$ÿÿ1ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ*ÿÿ)ÿÿ&ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÚÚ%%výÿÿïþ‚ÿ‚ÿ©ÿþ=ÚHWÿãðûÿVííìVV ïï.ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ+ÿÿ)ÿÿ'ÿÿ$ÿÿ ÿÿÿÿÿÿÿÿÿÿëëBBQõÿÿ÷Fþ‚ÿ‚ÿ¦ÿRNSöõøûÿþþSƒƒzÈÈ'ÿÿ1ÿÿ1ÿÿ0ÿÿ2ÿÿ2ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ)ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿððMMLôÿÿøHþ‚ÿ‚ÿ¦ÿþÉÉÎøÿSÂÂÁ””&ÿÿ2ÿÿ1ÿÿ0ÿÿ1ÿÿ2ÿÿ1ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ*ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿúúgg+ëÿÿýtþ‚ÿ‚ÿ£ÿ††ŠøÿSééë{{,÷÷/ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ*ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿzz'éÿÿÿ…þ‚ÿ‚ÿ£ÿþHIIøùùûÿSõõö˜˜Zîî,ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ*ÿÿ)ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿzz'éÿÿÿ…þ‚ÿ‚ÿ£ÿþ_E00ø®®ÿ±±ÿ±±õ««šƒDîî,ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ/ÿÿ0ÿÿ/ÿÿ-ÿÿ*ÿÿ(ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿzz'éÿÿÿ…þ‚ÿ‚ÿ£ÿþ_DøÿÿõšPîð.ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ*ÿÿ)ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿzz'éÿÿÿ…þ‚ÿ‚ÿ£ÿb‰þÿÿí[õõ/ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ*ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿùùff(ëÿÿýuþ‚ÿ‚ÿ¦ÿþbÅÿÿÿÎŒ}þþ1ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ*ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿððNNMôÿÿøHþ‚ÿ‚ÿ©ÿþeLöÿÿÿœ º¹#ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ(ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿëëBBRöÿÿ÷Dþ‚ÿ‚ÿ¬ÿûe>@BÕ½ÆÿDYÿÿûQ/ çè.ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ)ÿÿ'ÿÿ$ÿÿ ÿÿÿÿÿÿÿÿÿÿÜÜ%%výÿÿïþ‚ÿ‚ÿ²ÿü IJNþÝþþ_ÿðôÿotü”™šýý1ÿÿ1ÿÿ1ÿÿ2ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ+ÿÿ)ÿÿ'ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿ³³™ÿÿÿã‚ÿ‚ÿÄÿõ 1a9>¢¥®êêíþþúÿ[õ÷Ê~]?÷÷0ÿÿ1ÿÿ0ÿÿ2ÿÿ2ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ*ÿÿ(ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿ””¾ÿÿÿ³‚ÿ‚ÿÖÿ÷%@K‡¬Íïõû_kÿøúõÿþòVwx`ÇÉ%ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ3ÿÿ3ÿÿ2ÿÿ0ÿÿ/ÿÿ/ÿÿ,ÿÿ)ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿýý[[1Ýÿÿÿsþ‚ÿ‚ÿëÿø;&DYk“·Þâæ~xþÿÿÿÿÿ(8ÿßèûÿþþ\åçî|}n¿¿)þþ2ÿÿ0ÿÿ0ÿÿ1ÿÿ2ÿÿ2ÿÿ2ÿÿ1ÿÿ/ÿÿ/ÿÿ.ÿÿ+ÿÿ(ÿÿ&ÿÿ#ÿÿÿÿÿÿÿÿÿÿÿÿóóYôÿÿëGþ‚ÿ‚ÿÿøP K Y q †¤Ä Í ×àèçæååçRŸýÿÿÿÿÿÿ±Ãþÿb÷øú·¸ÄcdP»».ûû3ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ1ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ*ÿÿ(ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿÿÿþþªª•þÿÿÒþ‚ÿ¢ÿë~. T|‘ªÂÍÙÞç çæåååååååååçK¥üÿÿÿþýüs–××äjo~z6ÚÚ0þþ6ÿÿ3ÿÿ1ÿÿ1ÿÿK1ÿÿ2ÿÿ2ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ+ÿÿ)ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿøøYYâÿÿÿ˜‚ÿ¨ÿø~ 2D h}§Êèçæå å åååååååååååååææçâܼä½ ˜CgWtvÖ^Ö0ÿÿ9ÿÿ8ÿÿ5ÿÿ2ÿÿ1ÿÿ1ÿÿ1ÿÿ1ÿÿ1ÿÿ/ÿÿ0ÿÿ/ÿÿ.ÿÿ+ÿÿ)ÿÿ'ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÎÎcúÿÿ÷Wþ‚ÿ½ÿõ~ 4 O d z­ÏØÝæ ç æååååååååååååæçèä×Íà ³ª%– 9“Q’pŽ${'¸®5ºs²3ÌÏ9ßâ=íï=õö<ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ3ÿÿ3ÿÿ2ÿÿ2ÿÿ1ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ(ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿúúyyÇÿÿÿÖ"‚ÿÒÿõ~  E c{¢¯ÆÏØäè ç æåååååååååååååæåàÞÛà ¦…!| G‹m—(Œ¡2§¶;¸~Â@Ú×KæãNñïOüûPÿÿOÿÿKÿÿHÿÿEÿÿAÿÿ>ÿÿ=ÿÿ:ÿÿ9ÿÿ9ÿÿ7ÿÿ3ÿÿ3ÿÿ1ÿÿ1ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ(ÿÿ&ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÖÖ**L÷ÿÿÿ—‚ÿÕÿ~ ; [wš»Üßâä å åååååååååååååååååãáÞƨˆ yBX!€ƒ0˜9½ÀFæ~çTùùZûûZýýYÿÿXÿÿWÿÿUÿÿTÿÿRÿÿOÿÿNÿÿKÿÿHÿÿEÿÿCÿÿ?ÿÿ=ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ4ÿÿ3ÿÿ3ÿÿ1ÿÿ1ÿÿ/ÿÿ/ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ)ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿýý²ÿÿÿÿ'þ‚ÿØÿ~~ ÖÝàãåå åååååååååååååçèéàÔƾ¯¢ #— ?P‹r+’˜7¸¼EÞÞSêêYôôZøøZÿÿ[ÿÿZÿ~ÿYÿÿXÿÿWÿÿVÿÿUÿÿTÿÿSÿÿQÿÿPÿÿNÿÿLÿÿJÿÿGÿÿEÿÿCÿÿ@ÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ3ÿÿ3ÿÿ2ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿþþËË\ðÿÿý—þ‚ÿÞÿý~ rßåå ååååååååååææçáÚÒÍ­— !… 3‹U”€0¦5®»@ÈÌIØÔQèåUðîWÿþ\ÿÿ[ÿÿZÿÿYÿÿXÿÿWÿÿVÿÿVÿÿ~UÿÿUÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿMÿÿLÿÿJÿÿHÿÿFÿÿDÿÿBÿÿ@ÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ9ÿÿ7ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿôôJJ#Ëÿÿÿä1þ‚ÿÛÿ~YÞ ååååååååååæç绕kt Iw,˜4µ½CÓÕMëéVðïW÷÷Yþþ\ÿÿ[ÿÿZÿÿYÿÿXÿÿXÿÿWÿÿVÿÿVÿÿUÿÿTÿÿTÿÿSÿÿSÿ~ÿRÿÿQÿÿPÿÿOÿÿOÿÿNÿÿMÿÿLÿÿKÿÿIÿÿHÿÿFÿÿEÿÿCÿÿAÿÿ?ÿÿ>ÿÿ<ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ4ÿÿ2ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ,ÿÿ+ÿÿ)ÿÿ(ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿûû Œûÿÿüþ‚ÿÞÿ~>ÏææçãÚÒ̶ «“ /ŠH„a{$ro,¥£>ÐÏMûû]üü]ýý\þþ[ÿÿZÿÿYÿÿXÿÿXÿÿWÿÿWÿÿVÿÿUÿÿUÿÿTÿÿSÿÿRÿÿRÿÿQÿÿQÿÿPÿÿOÿÿOÿÿNÿ~ÿMÿÿLÿÿLÿÿLÿÿKÿÿJÿÿIÿÿHÿÿFÿÿFÿÿEÿÿCÿÿBÿÿAÿÿ?ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ2ÿÿ1ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿÿ(ÿÿ&ÿÿ%ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ¾¾LþÿÿÿÒ'‚ÿÞÿý~!ªÆ ²¨$”/’L“g”'}“/¢°<¶¿CÙ×QäâUïíWùøZÿÿ\ÿÿZÿÿYÿÿXÿÿWÿÿWÿÿVÿÿVÿÿUÿÿTÿÿTÿÿSÿÿRÿÿRÿÿQÿÿPÿÿOÿÿOÿÿNÿÿNÿÿMÿÿLÿÿLÿÿKÿÿJÿÿIÿÿ~IÿÿHÿÿGÿÿGÿÿFÿÿEÿÿDÿÿDÿÿBÿÿBÿÿAÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ2ÿÿ1ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ(ÿÿ'ÿÿ%ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿØØ@@2Ôÿÿÿúi‚ÿáÿþ~E[]%‹Ÿ7©·AºÃGÛÚTåâVñïYúù[ÿÿ]ÿÿ[ÿÿZÿÿYÿÿXÿÿWÿÿVÿÿVÿÿUÿÿTÿÿTÿÿSÿÿRÿÿRÿÿQÿÿQÿÿPÿÿOÿÿNÿÿNÿÿMÿÿMÿÿLÿÿKÿÿKÿÿIÿÿIÿÿHÿÿHÿÿGÿÿFÿÿFÿ~ÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ)ÿÿ)ÿÿ(ÿÿ&ÿÿ$ÿÿ#ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùù<ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿÿ(ÿÿ&ÿÿ%ÿÿ$ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿôôaa ¦ÿÿÿÿÛþ‚ÿÞÿ~ yy0ûûcÿÿbÿÿ`ÿÿ]ÿÿ[ÿÿYÿÿWÿÿVÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿOÿÿNÿÿMÿÿLÿÿKÿÿKÿÿJÿÿIÿÿIÿÿHÿÿHÿÿGÿÿFÿÿEÿÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿ~ÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ7ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ#ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿåågg—úÿÿÿçMû‚ÿáÿ~[[$ìì\ÿÿ`ÿÿ]ÿÿ[ÿÿXÿÿVÿÿTÿÿSÿÿQÿÿPÿÿNÿÿMÿÿLÿÿLÿÿJÿÿJÿÿIÿÿHÿÿHÿÿGÿÿFÿÿEÿÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿ~ÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ(ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþààHH&¡úÿÿÿôi‚ÿÞÿþ~88ÝÝUÿÿ_ÿÿ\ÿÿYÿÿVÿÿTÿÿRÿÿPÿÿNÿÿLÿÿKÿÿJÿÿIÿÿGÿÿFÿÿEÿÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿ~ÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ%ÿÿ%ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÄÄ66½ÿÿÿÿþ’þ‚ÿáÿþ~ ÖÖRþþ]ÿÿZÿÿWÿÿTÿÿQÿÿOÿÿMÿÿKÿÿIÿÿGÿÿFÿÿDÿÿCÿÿCÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ;ÿÿ9ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ7ÿÿ6ÿÿ5ÿÿ5ÿÿ4ÿÿ2ÿÿ1ÿÿ0ÿ~ÿ/ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ+ÿÿ*ÿÿ*ÿÿ)ÿÿ(ÿÿ(ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿîKæþÿÿÿø›þ‚ÿáÿþ~ µµDÿÿ]ÿÿYÿÿUÿÿRÿÿOÿÿLÿÿJÿÿHÿÿFÿÿDÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ9ÿÿ8ÿÿ7ÿÿ7ÿÿ5ÿÿ5ÿÿ4ÿÿ2ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿ~ÿ,ÿÿ+ÿÿ*ÿÿ*ÿÿ)ÿÿ(ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ%ÿÿ$ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿúúÇÇLL) ëÿÿÿÿõ’û‚ÿäÿþ~––7ûûZÿÿWÿÿTÿÿPÿÿMÿÿJÿÿHÿÿEÿÿCÿÿAÿÿ@ÿÿ>ÿÿ=ÿÿ<ÿÿ:ÿÿ:ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ3ÿÿ3ÿÿ2ÿÿ1ÿÿ1ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿ~ÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþçç}} XÑüÿÿÿÿün þ‚ÿáÿþ~zz,ôôWÿÿUÿÿQÿÿNÿÿKÿÿHÿÿEÿÿBÿÿ?ÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ1ÿÿ1ÿÿ0ÿÿ/ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ,ÿÿ+ÿÿ*ÿÿ*ÿÿ)ÿÿ(ÿÿ(ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ$ÿ~ÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùÒÒ ƒƒJ¸þÿÿÿÿÿã_þ‚ÿÞÿ~ZZ ííTÿÿTÿÿPÿÿLÿÿIÿÿEÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ4ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ+ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ$ÿÿ#ÿÿ"ÿÿ"ÿÿ ÿÿ ÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿóóÞÞ ¡¡YY-f¾ïþÿÿÿÿû¾>þ‚ÿÞÿ~IIááLÿÿRÿÿNÿÿJÿÿFÿÿCÿÿ@ÿÿ=ÿÿ;ÿÿ9ÿÿ7ÿÿ5ÿÿ3ÿÿ1ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ üüôô ìì ã㶶„„WW%..Y Ÿ×øÿÿÿÿÿþïŠ þ‚ÿÛÿþ~,,ËËCÿÿPÿÿLÿÿHÿÿDÿÿAÿÿ=ÿÿ;ÿÿ8ÿÿ6ÿÿ4ÿÿ1ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ$ÿÿ#ÿÿ#ÿÿ!ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþ üü úú ôô ¾¾ §§ ooDDGq Ëõüÿÿÿÿÿÿÿû¸8‚ÿÛÿþ~´´;üüNÿÿJÿÿEÿÿAÿÿ>ÿÿ;ÿÿ8ÿÿ5ÿÿ2ÿÿ/ÿÿ-ÿÿ+ÿÿ)ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿÿÿýý ññ çç ÛÛ ÀÀ¯¯‘‘$zz1JJOkx °Çéïöüÿÿÿÿÿÿÿÿÿÿ÷Çfþ‚ÿØÿþ~ œœ0ùùKÿÿGÿÿCÿÿ?ÿÿ;ÿÿ8ÿÿ5ÿÿ2ÿÿ/ÿÿ,ÿÿ*ÿÿ(ÿÿ&ÿÿ$ÿÿ#ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ~ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿ ÿÿýý ññ êê ÞÞ Åů¯ŠŠ ww)PPN;;i%%‡¤µÓÞîûÿÿÿÿÿÿÿÿÿÿÿÿÿÿþïÆd‚ÿÕÿ~rr"üüIÿÿEÿÿ@ÿÿ<ÿÿ9ÿÿ5ÿÿ2ÿÿ/ÿÿ+ÿÿ)ÿÿ&ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ~ÿÿÿ ÿÿ ÿÿ ÿÿ ÿÿÿÿ ÿÿÿÿÿÿíí ºº††llJJ@88Y‰¤ ¹Ûëõúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿí–Fþ‚ÿÒÿþ~ccòòDÿÿAÿÿ=ÿÿ:ÿÿ6ÿÿ2ÿÿ/ÿÿ*ÿÿ'ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿÿÿþþøø ôô ìì ÙÙ ¸¸££ŠŠ YYþ>lO k…»ëýþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþøîΠR ø‚ÿÒÿþ~==ÛÛ:ÿÿ@ÿÿ;ÿÿ7ÿÿ3ÿÿ.ÿÿ*ÿÿ'ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿ öö íí ßß ÔÔ ³³¢¢‚~‚*]]DMMS,,pŒ°ÅÜéñýÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþóêÙÕ±™|\?û‚ÿÉÿþ~ÈÈ2ÿÿ=ÿÿ8ÿÿ3ÿÿ/ÿÿ+ÿÿ'ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ýý ÷÷ òò íí ÈÈ ¯¯ yy]]1JJK++y‘²sÁÞìñüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿú÷ò뵓nZK$ ùþ‚ÿÀÿ~ºº-ÿÿ:ÿÿ5ÿÿ0ÿÿ,ÿÿ'ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ ÿÿ ÿÿ ÿÿ þþ úú ÷÷ ññ ÊÊ ¶¶ŒŒss FFGl}§Àôýýÿÿaÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþùöñ˪ˆbBõ‚ÿ®ÿ~••#ûû8ÿÿ3ÿÿ/ÿÿ)ÿÿ$ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ýý ððééÜÜÅů¯ŽŽ$xx2NNO55ax¡ ·ßéóüÿÿÿÿÿÿÿRÿÿÿÿÿÿÿÿÿÿÿÿÿÿýîãÖÀ¯ŒyS7ø‚ÿŸÿþ~nnðð5ÿÿ2ÿÿ-ÿÿ'ÿÿ"ÿÿÿÿÿÿÿÿÿÿýýóó íí ââ ÉÉ ±±‡‡rr&QQJ@@^((„ž´Õßîöÿÿÿÿÿÿÿÿÿÿÿÿÿ@ÿÿÿÿÿÿÿÿýñìâÆ­…rV?#ø‚ÿŠÿþ~DDòò5ÿÿ2ÿÿ-ÿÿ&ÿÿ ÿÿÿÿÿÿêê»» ››nnJJ?66X‡ ¤ºàñ÷úþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ+ÿÿÿÿÿغ™oF4 ø‚ÿ‚ÿ÷ÿþ~44 ÜÜ/çç*ÕÕ&··'¨¨%‹‹+\\EFFPi†¶Óöúûþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷ðåÖ¹¤Š]Cò‚ÿ‚ÿëÿ~01DNN^..x‘° ¿ØèîûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿõìßÕ±—zhU /  õ‚ÿ‚ÿÖÿýs ¤ìóüÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþûøðº¡s\J) õ‚ÿ‚ÿÁÿYû ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿý÷òêÊ·’xDõ‚ÿ‚ÿ¦ÿS cûÿÿÿÿÿÿÿÿÿÿÿýîæÖ¿¯ˆwU;ø‚ÿ‚ÿÿA Uëÿÿÿ ÿÿýôòèɱ’nUD#ø‚ÿ‚ÿ‹ÿþ, BÜ ýüûè »žuH>õ‚ÿ‚ÿ‚ÿûÿüi‰ `L  õ‚ÿ‚ÿ‚ÿæÿû õ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ°ÿ€ endstream endobj 9 0 obj 33388 endobj 10 0 obj /DeviceRGB endobj 11 0 obj << /Filter [ /RunLengthDecode ] /Width 106 /Height 106 /ColorSpace 10 0 R /BitsPerComponent 8 /Length 12 0 R >> stream ‚ÿ‚ÿîÿþôªª«§¦¨§§¨©«¨¨©¨þÒ‚ÿ‚ÿðÿþÿöõööõööôöãàãrqsþlmolntl^hY$>!Q(_þ‚ÿ‚ÿ<ÿôóôÊÈÊÊÇÊÊÉÊÊËÊ•™•,7+-?+/K++R$; Zu!Ž2³BÆLÒTÒ6U^Pþæ‚ÿ–ÿ þýþþýþáàሇˆþ‡AˆŠ‡ˆ‡dsb ' : Mc v Š¡¶Ò$Ý+á2å:æBçKèRæ>Ÿ- ÔÔÕ‚ÿ¨ÿbáàâàÞààÞààÞààßàáãàÐÖÎP[NFWC5P24Ur ¥¸ÈÒ Ûáåèèææ$ç-ç4æ;äEã=´1~þô‚ÿºÿþ÷©¨©£¢ý£b¤§£•Œ(0>Qd|“ š ´ÐÛ ß ãæççççææççã ÝØÏ(Ç8 J»@˜ 9þƒþû‚ÿÑÿ~þÿñðññïññïñŒŠŒ_]__`_`c_`h_UcS : U l…›²ÁÍÚ á åççææçææåâßÝÝ× Ã§)¨Q°!jµ,…»9 ÂHµÌ S·ÁXJN'€þù‚ÿÞÿ~õõöÀ¾À¾¼¿¿¾¿¿Á¿–œ•$0"$9!&G! ;A[w •¹ÌÔÛà å æèèçæçèçãÝØÒ Ìƾ +¶<¬R¨o©*Ž«7®ÃDÚåUåì\ïðcõóhúømÿýtòðqut3hhbþù‚ÿöÿýû úûûúûûùûäâä}ý{~~{|ƒ{cr` ) < Qh|¦ºÐÝá å æççççææåäáßÚÍ ¼±(±F²Z´!s¶*Ž»4¦Á<¾ÈEÓØLééTóòYúø[ÿý^ÿþ`ÿÿbÿÿdÿÿgÿÿkÿÿoøøo——Fyyo¹¹ºƒÿ öõö×Õ×ÖÔ××Ö×þÁ~AD@9B8:H8;P82Q-;Y s ¬ÀÍÕÝ ã åèèçæçèæãàÛ×Ó ÏÄ­ 0 N¤oª)¸4°Ë@ÉÙHÖàLçéQîîSöôUýúVÿ+þWÿÿWÿÿVÿÿVÿÿWÿÿWÿÿYÿÿ[ÿÿ^ÿÿaÿÿdÿÿiþþm²²N@@+þÙ†ÿþÒ~—–—inh : P d q …›²ÐÝà ã æ ççççææææãÝ×Π¼ +·;´R´k²(ƒ³0³:¶ÀBÙÞNîïVôôWúøWþûWÿþWÿ=ÿWÿÿVÿÿTÿÿRÿÿQÿÿQÿÿPÿÿPÿÿPÿÿQÿÿRÿÿSÿÿUÿÿXÿÿ[ÿÿ_ÿÿcþþhÈÈV''ƒƒ„þýÿþÁ~RPRTXR1J,?{¥ÂÐÜâ å èçææççæäáÞÛÛÕ Á§+¢O«n³(…»0¥Æ<¸ÏBÏÙKÝáOêêSõóVûùXÿÿXÿÿWÿÿVÿÿTÿÿSÿ@ÿRÿÿQÿÿPÿÿPÿÿNÿÿMÿÿLÿÿLÿÿLÿÿKÿÿLÿÿLÿÿMÿÿNÿÿPÿÿSÿÿVÿÿZÿÿ^ÿÿdÝÝYjj:þ›þÙ’ÿ~äã䧦§") ' kµÙãç èçææççãÝ×Ñ ÊÄ"» 3¶F¯\ª"x©,”©7´ÂAØáNëïTòòUøõVûùWÿþWÿÿWÿÿWÿÿUÿÿTÿÿRÿÿQÿÿPÿÿOÿIÿNÿÿNÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿGÿÿFÿÿEÿÿEÿÿFÿÿGÿÿHÿÿIÿÿKÿÿNÿÿQÿÿUÿÿYÿÿ_éé[``$™’ÿþý~ãáãIKH'z¿áç ççäàÞÜÎ ½¬)­G±bµ$|¹-•¾6¨Å=ÄÎGØÜNêêSôòWúùWÿþXÿÿWÿÿVÿÿUÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿIÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿAÿÿAÿÿ@ÿÿ@ÿÿAÿÿBÿÿDÿÿGÿÿJÿÿMÿÿQÿÿUÿÿ[ôô\}}.FF?þÙ•ÿ~øùø}~|)7%a»áççãÕ Ä± 2œQžs©+”¶7±Ê@ÐÞKÜåNéëRòñUù÷VþûWÿþWÿÿWÿÿVÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿOÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ;ÿÿ<ÿÿ=ÿÿ>ÿÿ?ÿÿBÿÿEÿÿIÿÿMÿÿRÿÿWúú[——7QQCÜÜÝ•ÿ~¸·¸kmj 8”ßçæâƧ Q¡©6¿ÅGæçUôóXûùXÿüXÿþWÿÿWÿÿUÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿAÿÿ@ÿLÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ7ÿÿ7ÿÿ7ÿÿ8ÿÿ9ÿÿ;ÿÿ>ÿÿ@ÿÿEÿÿIÿÿNÿÿSýýY±±?^^GþÚ•ÿ~åäåTVT=¸ã çåÌš l)¾ÊFèçTüûZÿÿZÿÿWÿÿTÿÿSÿÿQÿÿQÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿGÿÿEÿÿDÿÿCÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿOÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ3ÿÿ5ÿÿ6ÿÿ9ÿÿ<ÿÿ@ÿÿEÿÿJÿÿOþþVÌÌI55ŽŽ•ÿ~¯®¯%aËçæÙ®Y’"ÂÇH÷õYÿÿZÿÿWÿÿTÿÿQÿÿPÿÿNÿÿMÿÿLÿÿJÿÿIÿÿGÿÿGÿÿFÿÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ?ÿÿ=ÿÿ=ÿÿ=ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ7ÿÿ6ÿHÿ5ÿÿ4ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ+ÿÿ+ÿÿ,ÿÿ.ÿÿ1ÿÿ4ÿÿ7ÿÿ;ÿÿ?ÿÿEÿÿKÿÿRØØþKþmþô˜ÿ~¹¸¹ ]ÍçæÍ*•”¬7èæUÿþZÿÿWÿÿSÿÿPÿÿNÿÿLÿÿJÿÿHÿÿGÿÿFÿÿEÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿOÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ&ÿÿ&ÿÿ&ÿÿ&ÿÿ'ÿÿ(ÿÿ*ÿÿ-ÿÿ2ÿÿ6ÿÿ;ÿÿ@ÿÿFÿÿMîîOii&rrlþò˜ÿ~÷ø÷iohJÓæäÃ?‹ÄÊJûùZÿÿWÿÿSÿÿPÿÿMÿÿJÿÿHÿÿFÿÿDÿÿCÿÿBÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ3ÿÿ1ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿOÿ*ÿÿ)ÿÿ'ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ#ÿÿ!ÿÿ!ÿÿ ÿÿ ÿÿ ÿÿ!ÿÿ"ÿÿ$ÿÿ&ÿÿ*ÿÿ0ÿÿ5ÿÿ;ÿÿAÿÿHòòKvv$NNHþô˜ÿþù~||HÀçå»V‘ ÐÓMÿþZÿÿVÿÿQÿÿNÿÿKÿÿGÿÿEÿÿCÿÿAÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ3ÿÿ1ÿÿ0ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ)ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿOÿ#ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ!ÿÿ$ÿÿ)ÿÿ/ÿÿ5ÿÿ;ÿÿBûûI››/%%¡¡¢•ÿ~#ªååÈSÝÝQÿÿZÿÿTÿÿPÿÿLÿÿIÿÿEÿÿBÿÿ@ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ1ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ)ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿOÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ!ýý%÷÷,òò2çç=ÞÞG¦¦211žþþ˜ÿþâ~BJ@ãçÌ?ÐÒMÿÿZÿÿTÿÿOÿÿKÿÿGÿÿDÿÿ@ÿÿ>ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ5ÿÿ3ÿÿ0ÿÿ.ÿÿ-ÿÿ+ÿÿ)ÿÿ'ÿÿ%ÿÿ$ÿÿ"ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿIÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüü÷÷ññßßÏϺº-¥¥=Nrre\\v::Žr!þ¡þþ˜ÿþæþI~AÎ çÝ'˜¹ÂEþý[ÿÿUÿÿPÿÿKÿÿGÿÿCÿÿ@ÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ7ÿÿ6ÿÿ4ÿÿ3ÿÿ1ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ'ÿÿ&ÿÿ#ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ'ÿÿÿÿÿÿÿÿÿþþûûööïïççÃÃ¥¥!„„8jjþVo>>Œ++¤»ÌÜêôÛežž¢’ÿ~a`b¡æå ±‘¥6ùøZÿÿVÿÿQÿÿLÿÿGÿÿCÿÿ?ÿÿ=ÿÿ:ÿÿ9ÿÿ9ÿÿ7ÿÿ6ÿÿ5ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ.ÿÿ-ÿÿ+ÿÿ)ÿÿ'ÿÿ%ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýOýøøððææÙÙÆÆ$µµ,““?K\\c77~’» Ùêñöüÿÿÿÿÿïd}}„þþý’ÿþS~KÖèÍNéèVÿÿXÿÿRÿÿMÿÿHÿÿCÿÿ@ÿÿ=ÿÿ;ÿÿ9ÿÿ8ÿÿ6ÿÿ5ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ+ÿÿ*ÿÿ(ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿýýööððßßÆƯ¯ :xIxQ__jII55• ®ÁÚèôûÿÿÿÿÿÿÿþøñãÅv,,6ÍÍÌ’ÿ~ëëìEQC£æ⢠¹ÄEÿþ[ÿÿTÿÿOÿÿIÿÿDÿÿ@ÿÿ>ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ.ÿÿ.ÿÿ-ÿÿ*ÿÿ&ýý"ôô!îî ââ"ÖÖ$ÄÄ*œœ4€€>w))•´IÎ ßêòùþÿÿÿÿÿÿüõïå×Àž‚]=##O00O<ØçÎcœ&ïíWÿÿWÿÿQÿÿKÿÿFÿÿAÿÿ>ÿÿ;ÿÿ9ÿÿ8ÿÿ5ÿÿ3ÿÿ0ÿÿ0ÿÿ0ÿÿ0ÿÿ0ûü.óô-éì+ÛØ'ÎÆ#ɶ"©Ÿ8‹ŒNkkfTTw88 £¹Ùìõûþÿ:ÿÿÿÿÿþ÷ñáʺŸŠoX?"RRbrrzrruþr ssqÙÙ×øøöùùøÿþâ~492ãå´ª·@þþZÿÿSÿÿNÿÿIÿÿDÿÿ?ÿÿ<ÿÿ:ÿÿ8ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0ÿÿ0üü.ââ.¦§9¨€8®HÀ2Ê"ÉTŽßíõüÿÿÿÿÿÿþú4öí⟂dJ6 37,„„‹¶¶¸¶¶´¶¶´¶¶µïïî‚ÿùÿ~Ø×Ù '° çÝ>‘åäUÿÿWÿÿQÿÿLÿÿFÿÿAÿÿ>ÿÿ;ÿÿ9ÿÿ7ÿÿ5ÿÿ1ÿÿ0ÿÿ0ÿÿ0÷÷.º»8 zÏÒÕò›¦õ ûþö m•ÿÿÿþøñä×À¬“%xa900QUUeUU_UUZUUWUUSUUS££¡ììêììêþü‚ÿíÿþýGwuw EÏèÊ„§2üúZÿÿUÿÿOÿÿJÿÿDÿÿ@ÿÿ=ÿÿ:ÿÿ9ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0÷ø.¾¿=²³¥ìíðýÿ=ÐÖÿ.3ÿýò}wâŪŽ{ l V @ ,WWišš¢šššš™šš™ÖÖÕ‚ÿÏÿþûD464 eß詾ÌGÿÿYÿÿSÿÿLÿÿHÿÿBÿÿ>ÿÿ;ÿÿ9ÿÿ8ÿÿ5ÿÿ2ÿÿ0ÿÿ0ýý/¿¶(³¡ˆ÷÷úþÿþý ãÕÚÅAGš~X( +'J;;T;;K;;D‡‡‹üÙ ØÙÙ×ÙÙ×ññï‚ÿÀÿWûúû:B8‡æá,¡ÞâQÿÿXÿÿQÿÿKÿÿFÿÿAÿÿ=ÿÿ;ÿÿ9ÿÿ7ÿÿ3ÿÿ1ÿÿ0ÿÿ0èç+—DæGJÿÆÊúö÷²²³FHL"xppú~}ÖÖÔüüúüüûüüûÿÿþ‚ÿ±ÿPûúû;I8ž é×Q§íìUÿÿVÿÿPÿÿJÿÿEÿÿ@ÿÿ<ÿÿ:ÿÿ8ÿÿ6ÿÿ2ÿÿ0ÿÿ0þþ0³£ þü17­mu%%&\\]þÅþý‚ÿ™ÿPûùûÿÿ;ÿÿ9ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0àÞ+Ã_3úEGÿHHš''{uuþù‚ÿÿGûùû=\8Öçͼ7þúZÿÿSÿÿNÿÿHÿÿBÿÿ>ÿÿ;ÿÿ9ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0àà,¿¸Œúëîÿð𡘘þEþÞ‚ÿÿAûùû=[8ÓçÌ‹¹5ýùZÿÿTÿÿNÿÿHÿÿBÿÿ>ÿÿ;ÿÿ9ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0éé,­®vööùþÿÄÅÆþÄ‚ÿÿAûùûÿýZÿÿTÿÿMÿÿHÿÿBÿÿ>ÿÿ;ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ0ÿÿ0ÿÿ0ýý/ÒÊ%™@ Öøÿÿ²¸øÿ~ÇÇÿ""ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþõá«Z199>»»¹þì¤ÿUÔÒÔ< à èÔc–%öôZÿÿVÿÿOÿÿJÿÿDÿÿ@ÿÿ=ÿÿ:ÿÿ9ÿÿ8ÿÿ5ÿÿ3ÿÿ1ÿÿ0ÿÿ0þÿ0ØÖ(£rª#Ò/2íÄËö÷øööýø~¿¿ø øøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøûÿÿÿÿÿõÇ u+WWZëëê§ÿ~ÖÕÖ Ÿçâ&ŸÏÒMÿÿYÿÿRÿÿLÿÿFÿÿBÿÿ>ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ6ÿÿ3ÿÿ1ÿÿ0ÿÿ0ÿÿ0ñó+ÒÉ!¶'¥žP®®p°°q²²pššoXXoKKnKKnKKnKKmKKmKKmKKmKKlKKmKKmKjKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKmKKlKKlKKlKKlHHl//xž ÌèøÿÿÿõÅ`66Düüû­ÿþæ~?@>bßæÁŠ§4ûùZÿÿTÿÿOÿÿIÿÿEÿÿ@ÿÿ>ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ6ÿÿ4ÿÿ2ÿÿ0ÿÿ0ÿÿ-ÿÿ+ûý'ôõ#óó#ôô!ôôóóóóóóóóóóóóóóóóóóóóóóóóóóójóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóóììÍÍŸŸrr=::y´æýÿÿóŸ<}}~ÆÆÅ­ÿ~ŸžŸ'Ë ç×B›ÞÞRÿÿYÿÿRÿÿLÿÿHÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ4ÿÿ1ÿÿ0ÿÿ.ÿÿ+ÿÿ)ÿÿ'ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿjÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷÷ÙÙ¥¥$ZZS éÿÿûÉQ!!%þ½°ÿþò~IMHzãæ ³Œ©4üúZÿÿVÿÿPÿÿKÿÿFÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ7ÿÿ4ÿÿ0ÿÿ/ÿÿ-ÿÿ+ÿÿ)ÿÿ&ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿmÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿññ··PPO ¹óÿÿæe*¾¾½°ÿ~VTV/à èÝ)”ÊÍKÿÿYÿÿTÿÿOÿÿJÿÿFÿÿBÿÿ?ÿÿ=ÿÿ;ÿÿ9ÿÿ9ÿÿ9ÿÿ8ÿÿ4ÿÿ1ÿÿ/ÿÿ-ÿÿ+ÿÿ)ÿÿ'ÿÿ%ÿÿ#þþ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿWÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿææ‹‹þ)}äÿÿêw!!*¾¾½þþ¶ÿ~ÊÉÊxàæÊ]“#èçUÿÿXÿÿRÿÿNÿÿIÿÿFÿÿBÿÿ?ÿÿ=ÿÿ<ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ6ÿÿ3ÿÿ0ÿÿ.ÿÿ-ÿÿ+ÿÿ*ËË žžùù%ÿÿ&ÿÿ%ÿÿ%ÿÿ$ÿÿ$ÿÿ$ÿÿ$üü#ÄÄpœœ««îî!ÿÿ$ÿÿ$ÿÿ$üü#µµªª÷÷"ÿÿ#ÿÿ#ÿÿ"ÿÿ"ÿÿ"ÿÿ!ÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿùùÁÁGGUÑþÿîn&þܶÿþõþY~!µç䮃¡2ôóYÿÿWÿÿRÿÿMÿÿJÿÿFÿÿCÿÿ@ÿÿ>ÿÿ=ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ5ÿÿ3ÿÿ1ÿÿ/úú-€€--žž©©©©¨¨ÊÊ!üü*ÿÿ*ÿÿ*øø(€€>> ?? ?? ?? =p= ddãã%ÿÿ*ÿÿ*ÿÿ*ôô'SS iiöö'ÿÿ(ÿÿ'ÿÿ'ÿÿ'ÿÿ'ÿÿ&ÿÿ%ÿÿ%ÿÿ$ÿÿ#ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿØØ[[G Áýÿâ[vvwÃöÿþê~XYX RÖ çÝ¡  ¯<üú[ÿÿWÿÿRÿÿNÿÿJÿÿGÿÿDÿÿAÿÿ?ÿÿ>ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ8ÿÿ6ÿÿ5ññ0^^(())))**ŠŠûû/ÿÿ/ÿÿ/÷÷.ËË%½½"½½"½½"½½"¼p¼"ÓÓ&úú.ÿÿ/ÿÿ/ÿÿ/ää)77 ttàà&ââ'áá&èè'ýý*ÿÿ*ÿÿ)ÿÿ)ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿââcc>ÊÿÿÐ)bb`þü¶ÿ~ðïð\d[yÝ æÜ!’ §µ>÷öYÿÿWÿÿSÿÿOÿÿLÿÿIÿÿFÿÿDÿÿAÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ãã399 \\  #¡¡#  #¥¥#ßß0ÿÿ7ÿÿ7ÿÿ8ÊÊ+>> ((((((((,p, ‘‘ûû5ÿÿ6ÿÿ5ÿÿ5ÂÂ'&&%%%%bbôô,ÿÿ.ÿÿ-ÿÿ-ÿÿ,ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ%ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿååMMNÔÿÿ± #þŠþû¶ÿ~ÏÐÏ* ”äæÕ#› “§8õóZÿÿYÿÿTÿÿPÿÿMÿÿKÿÿHÿÿFÿÿDÿÿBÿÿAÿÿ@ÿÿ>ÿÿ>ÿÿ=ÿÿ>ÏÏ1$$ $$##55 ËË/ÿÿ<ÿÿ<ÿÿ<áá5©©)¢¢'¢¢'¢¢'¢¢'¥¥'×p×2ÿÿ;ÿÿ;ÿÿ;ÿÿ:žž#%%˜˜"­­&­­$­­"ÉÉ&üü/ÿÿ/ÿÿ/ÿÿ/ÿÿ/ÿÿ/ÿÿ.ÿÿ.ÿÿ-ÿÿ,ÿÿ)ÿÿ'ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÌÌ::gñÿòm þ’¶ÿþ÷þq~«ãæÜ¡}ž/ááRÿþZÿÿVÿÿSÿÿPÿÿNÿÿKÿÿIÿÿHÿÿGÿÿEÿÿDÿÿCÿÿBÿÿB¤¤*==¾¾1××8××8××8ÛÛ9÷÷?ÿÿAÿÿAúú@¢¢)[[ZZ[[[[YYppßß8ÿÿAÿmÿ@ÿÿ?ùù=ww==óó7ÿÿ:ÿÿ9ÿÿ8ÿÿ5ÿÿ3ÿÿ2ÿÿ1ÿÿ1ÿÿ1ÿÿ1ÿÿ0ÿÿ0ÿÿ0ÿÿ/ÿÿ-ÿÿ+ÿÿ(ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿýý««šûÿË(QQO³ÿ~ÃÂÃjij5¤ã çá³K•´¼DóòYÿÿYÿÿVÿÿSÿÿQÿÿOÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHþþH±±2‘‘*ööEÿÿIÿÿHÿÿHÿÿHÿÿHÿÿHÿÿHùùF««1tt"uu"uu"uu"tt"ŠŠ(ëëBÿpÿGÿÿFÿÿE÷÷B——(‘‘$ùù=ÿÿ<ÿÿ:ÿÿ9ÿÿ9ÿÿ7ÿÿ3ÿÿ3ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ1ÿÿ0ÿÿ.ÿÿ,ÿÿ)ÿÿ%ÿÿ"ÿÿÿÿÿÿÿÿöörr:Ìÿù~,,.þγÿ~üüýŠ‹Š *–à çåÏŸ p—*ÐÔMöôYÿÿZÿÿXÿÿUÿÿSÿÿQÿÿQÿÿPÿÿOÿÿOÿÿOøøLööLþþNÿÿNÿÿNÿÿNÿÿNÿÿNÿÿNÿÿNÿÿNúúMøøLùùLùùLùùLøøLúúMþþMÿÿMÿpÿLÿÿKþþHööDööBÿÿAÿÿ?ÿÿ<ÿÿ:ÿÿ9ÿÿ9ÿÿ7ÿÿ4ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ4ÿÿ3ÿÿ2ÿÿ0ÿÿ.ÿÿ,ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÒÒ55wõÿÛ$˜˜—°ÿþü~ ! ÐççâÆ!— n£)±ÀBááS÷õYÿÿZÿÿYÿÿXÿÿWÿÿVÿÿVÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿUÿÿVÿÿUÿÿTÿÿSÿÿRÿÿQÿmÿOÿÿLÿÿIÿÿFÿÿBÿÿ?ÿÿ<ÿÿ:ÿÿ9ÿÿ9ÿÿ7ÿÿ4ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ4ÿÿ4ÿÿ4ÿÿ2ÿÿ0ÿÿ.ÿÿ+ÿÿ(ÿÿ$ÿÿÿÿÿÿÿÿúú‰‰, Ëÿû{ddiññð°ÿþü~Œ‘‹)` ¹â çæàȯ C¡o¡*š©:ÃÊIæëVìïXëïWëïVëïVëïVëïVëïVëïVëïUëïUëïUëïUëïUëïUëïUëïUëïUëïUëïUëïUëïUëïUëïUëïTëïRëïPëïNëjïLëïIëïEëïBëï>íï=ïï<ïï:ïï:ïï8óõ6üþ4ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ4ÿÿ4ÿÿ2ÿÿ0ÿÿ-ÿÿ*ÿÿ'ÿÿ"ÿÿÿÿÿÿÿÿÑÑ&&ƒûÿ¹$ÙÙØ­ÿ~ûüûßàÞ¼½¼ (xÇâççäÚÔ Ê«Ÿ ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž ž jž ž ž ž $ž m£V§¨¨¨§§¡Ÿ€¡€C¶–!Û×+ùû2ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ1ÿÿ/ÿÿ,ÿÿ)ÿÿ%ÿÿ ÿÿÿÿÿÿøømm<áÿâM¯¯­þþªÿ~ïîŠ06/ 8~Ãáæ ççæåäääääääääääääääääääääääääääääädääåŽòüýþýýÿýýÿúëðîXcÉ¢5 ²™òó1ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ3ÿÿ2ÿÿ/ÿÿ.ÿÿ*ÿÿ&ÿÿ"ÿÿÿÿÿÿÿÿ¹¹ ¬ÿøt99=þû¤ÿþÜ~™—š)1' - ^£ÍÜäåå å å å åååååååååååååååååååååååååååååòýþýýþþÿRÙÜÿ9>ÿñ¼«ƒïï.ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ2ÿÿ0ÿÿ.ÿÿ+ÿÿ'ÿÿ$ÿÿÿÿÿÿÿÿââ66}ùÿ¢88Fûûúžÿ~ñðñ‚ƒiih*1]„ƒƒƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒ ƒƒƒƒƒƒƒ„Q‹Q‘’‘þ’V‘““—opÂõÿü½$©›,øù/ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ0ÿÿ/ÿÿ,ÿÿ)ÿÿ%ÿÿ!ÿÿÿÿÿÿòòbbZêÿÑ88Wüüú•ÿtÅÅƬ«­­®­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­®´­­´­­´­­´­­´­­´­­´­­´­²µ²øµS„~~9ƒïÿ)5ô§¢š‚ÌÍ-ÿÿ1ÿÿ1ÿÿ1ÿÿ2ÿÿ0ÿÿ/ÿÿ-ÿÿ)ÿÿ&ÿÿ"ÿÿÿÿÿÿûû††?Ùÿê7¤¤¢‚ÿ–ÿSùúúÜßß\NNy$*ð¼ÆÿýÿãääššGóó.ÿÿ1ÿÿ1ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ*ÿÿ'ÿÿ#ÿÿÿÿÿÿÿÿ££-ÇÿôFxxw‚ÿÿþà ¹¹½þÿ>ùùû¯¯‰ØØ,ÿÿ1ÿÿ1ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ+ÿÿ(ÿÿ$ÿÿÿÿÿÿÿÿ´´#»ÿø^þ{‚ÿÿþôiijstvûýýþÿ>Ê̸ÃÄ1ÿÿ0ÿÿ1ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ(ÿÿ$ÿÿÿÿÿÿÿÿÄÄ!!±ÿüt{{|‚ÿÿþGJ@@ôÓÓÿÛÜÚ¾¯ÈÃ<þþ/ÿÿ1ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ(ÿÿ$ÿÿ ÿÿÿÿÿÿÆÆ""±ÿüu{{|‚ÿÿJ€M õ22ÿ34Ù<,ȯ'þÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ,ÿÿ(ÿÿ$ÿÿÿÿÿÿÿÿÅÅ!!±ÿüt{{|‚ÿÿþìGWSS‚üþÉĶ#ÿÿ2ÿÿ1ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ,ÿÿ(ÿÿ$ÿÿÿÿÿÿÿÿµµ!¹ÿùaþ{‚ÿ“ÿPòòñ[]]Ãÿú±1 Ù×)ÿÿ1ÿÿ1ÿÿ2ÿÿ1ÿÿ0ÿÿ.ÿÿ+ÿÿ(ÿÿ#ÿÿÿÿÿÿÿÿ¥¥-ÇÿôHyyx‚ÿ™ÿþýSÅÆÆ\\]”‡‹önxÿá™jôõ0ÿÿ1ÿÿ2ÿÿ2ÿÿ1ÿÿ/ÿÿ.ÿÿ+ÿÿ'ÿÿ#ÿÿÿÿÿÿüüŠŠ=×ÿë 5šš—‚ÿ±ÿnüûüüûüüúüòðòŠ‰Š~}~~~†~~pp-KEJ¥¦©ö÷÷ÿñóô‹¡8ÍÆ%ÿÿ1ÿÿ1ÿÿ2ÿÿ2ÿÿ1ÿÿ/ÿÿ-ÿÿ*ÿÿ&ÿÿ"ÿÿÿÿÿÿóóddXéÿÔ77Wúúø‚ÿÃÿ üûüÚØÚÙ×ÙÙ×ýÙ&²´±ßÛ@æç?òô?ùúH<þþ9ÿÿ9ÿÿ7ÿÿ3ÿÿ2ÿÿ1ÿÿ1ÿÿ0ÿÿ/ÿÿ-ÿÿ*ÿÿ(ÿÿ$ÿÿ ÿÿÿÿÿÿûû( ÆÿüXX^þíÿ~Ÿ¥ž2O- <Rn «¿ Ë Õ ÝâåèéééæáÞÙÕ Ñ˾ (®8¤]§"z«-˜º8ºÑDÓàLáçOìíQôòRûøSÿüRÿÿOÿÿLÿÿGÿÿCÿÿ?ÿIÿ<ÿÿ:ÿÿ8ÿÿ5ÿÿ3ÿÿ2ÿÿ0ÿÿ/ÿÿ/ÿÿ-ÿÿ+ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÙÙ>>nòÿã+˜˜—’ÿþÍ~g ÁÜà äæçèççæåâÞ×Ⱦ¹ 2¶Fµ^¶"tµ+¸4§º=ÄËGßâQïðVööWüúXÿüXÿÿWÿÿVÿÿUÿÿSÿÿQÿÿOÿÿLÿÿIÿÿFÿÿCÿÿ@ÿIÿ=ÿÿ:ÿÿ9ÿÿ7ÿÿ4ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ,ÿÿ*ÿÿ(ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿøø{{5Æÿû‡$$'þÅ•ÿþþ~}}; Ç èçåãàÜÙÙ Ô¼£ 4¢X« u´+—Â7±Ì@ÁÕF×ßMäæQïïT÷ôWýúXÿÿXÿÿWÿÿVÿÿUÿÿSÿÿSÿÿQÿÿPÿÿOÿÿNÿÿMÿÿKÿÿIÿÿGÿÿDÿÿAÿÿ?ÿLÿ=ÿÿ:ÿÿ9ÿÿ7ÿÿ4ÿÿ2ÿÿ0ÿÿ/ÿÿ-ÿÿ,ÿÿ)ÿÿ'ÿÿ$ÿÿ!ÿÿÿÿÿÿÿÿþþ¶¶ùÿÒ3ddb’ÿþž~=«ÕÍÆ¿ (º<¶P±k®'„­0›­:ÁËFãéRïòVõôWú÷WþüWÿÿXÿÿWÿÿVÿÿUÿÿTÿÿRÿÿQÿÿPÿÿOÿÿNÿÿNÿÿLÿÿKÿÿKÿÿJÿÿIÿÿGÿÿFÿÿEÿÿCÿÿAÿÿ?ÿÿ=ÿÿ;ÿIÿ:ÿÿ8ÿÿ6ÿÿ3ÿÿ1ÿÿ/ÿÿ-ÿÿ,ÿÿ*ÿÿ(ÿÿ&ÿÿ#ÿÿ ÿÿÿÿÿÿÿÿÿÿÓÓBB]íÿõuþÞ•ÿ~¨§¨6mT¯!q¹,‹½5¡Ä=¹ÍDÌÕKÞáPíìU÷õWýûXÿÿXÿÿWÿÿVÿÿUÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ=ÿÿ<ÿÿ;ÿLÿ9ÿÿ8ÿÿ5ÿÿ2ÿÿ1ÿÿ/ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿÿ&ÿÿ$ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿêêYYEÍÿÿº$þyþ÷˜ÿ~ññògg\Œ4åé[ïð\÷õ[üú[ÿýZÿÿYÿÿXÿÿVÿÿTÿÿSÿÿRÿÿQÿÿPÿÿOÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿOÿ6ÿÿ3ÿÿ1ÿÿ/ÿÿ-ÿÿ-ÿÿ+ÿÿ)ÿÿ(ÿÿ&ÿÿ$ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿêêqq3ÀýÿÙ3[[Yþø˜ÿ~ôôõuun{{1óó]ÿÿ`ÿÿ\ÿÿXÿÿVÿÿSÿÿQÿÿPÿÿNÿÿMÿÿLÿÿKÿÿJÿÿIÿÿHÿÿGÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ?ÿÿ>ÿÿ=ÿÿ<ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ2ÿÿ1ÿRÿ0ÿÿ.ÿÿ-ÿÿ,ÿÿ*ÿÿ)ÿÿ'ÿÿ&ÿÿ%ÿÿ#ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿßßii< ¶üÿçfeef··¶˜ÿþô~nnm]]#ääVÿÿ]ÿÿXÿÿUÿÿRÿÿOÿÿMÿÿKÿÿIÿÿGÿÿFÿÿEÿÿDÿÿCÿÿBÿÿAÿÿ@ÿÿ@ÿÿ>ÿÿ>ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ2ÿÿ1ÿÿ0ÿÿ0ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿOÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ#ÿÿ"ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿüüÍÍTTFÅüÿô~$ÙÙؘÿþò~kkiEEÛÛPÿÿZÿÿUÿÿQÿÿNÿÿKÿÿHÿÿEÿÿDÿÿBÿÿAÿÿ?ÿÿ>ÿÿ=ÿÿ=ÿÿ<ÿÿ;ÿÿ:ÿÿ:ÿÿ9ÿÿ8ÿÿ7ÿÿ6ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ0ÿÿ/ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿRÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿìì››#22nßÿÿî‡ ƒƒüüý›ÿþôþl~44ÂÂFþþXÿÿSÿÿNÿÿJÿÿGÿÿDÿÿAÿÿ?ÿÿ>ÿÿ<ÿÿ;ÿÿ:ÿÿ9ÿÿ9ÿÿ8ÿÿ7ÿÿ5ÿÿ4ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ.ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ%ÿÿ%ÿÿ$ÿÿ"ÿÿ"ÿÿ ÿÿ ÿÿÿÿÿLÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ÷÷ÅÅaaC©îÿÿìt(––•þטÿþŽ~ ¯¯=üüUÿÿPÿÿKÿÿGÿÿCÿÿ?ÿÿ=ÿÿ:ÿÿ9ÿÿ7ÿÿ6ÿÿ5ÿÿ3ÿÿ2ÿÿ1ÿÿ0ÿÿ/ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ'ÿÿ%ÿÿ%ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿLÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûûää··jjBáþÿýÕ^®®­•ÿþÚ~QQB’’0øøRÿÿNÿÿHÿÿDÿÿ?ÿÿ<ÿÿ9ÿÿ6ÿÿ4ÿÿ2ÿÿ0ÿÿ.ÿÿ-ÿÿ,ÿÿ+ÿÿ*ÿÿ)ÿÿ(ÿÿ'ÿÿ&ÿÿ%ÿÿ$ÿÿ#ÿÿ!ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿLÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ üü õõ îîÕÕ¯¯……3IIh£Þûÿÿö¯Ejjm··¶•ÿþÝ~DD=xx$ññLÿÿKÿÿEÿÿ@ÿÿ<ÿÿ8ÿÿ5ÿÿ2ÿÿ/ÿÿ,ÿÿ*ÿÿ)ÿÿ'ÿÿ&ÿÿ$ÿÿ$ÿÿ#ÿÿ"ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿLÿÿÿ þþ úú ôô ììßßÒÒ´´$””.{{;XX]77{%%“»ÚñÿÿÿúÓp%%<||}øø÷•ÿþÙ~??<]]ææFÿÿHÿÿAÿÿ<ÿÿ8ÿÿ4ÿÿ0ÿÿ,ÿÿ)ÿÿ'ÿÿ$ÿÿ#ÿÿ!ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ûû õõ êê ÚIÚÈȯ¯&——8Lgg`NNv//’ª ÆàïöüþÿÿÿÿøÓˆ1HHMããáþý’ÿ~˜˜—@@ÙÙ?ÿÿDÿÿ>ÿÿ9ÿÿ4ÿÿ/ÿÿ+ÿÿ'ÿÿ$ÿÿ"ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ üü ùù óóììàà»»––!zz<__\GFG{55“$$®à Öäî÷ýÿÿÿÿÿÿÿÿúí»l+ *§§¦þäÿ~²²³LL%ÆÆ5ÿÿ@ÿÿ:ÿÿ4ÿÿ/ÿÿ*ÿÿ%ÿÿ!ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ üü öö ëë ààÎν½"§§.ŠŠBrrSRRk11ƒÃäïFôúýÿÿÿÿÿÿÿÿÿùõèÛɬ|9,,=RRURRPÁÁÀŒÿ~ºº¼22¨¨(ûû<ÿÿ6ÿÿ0ÿÿ*ÿÿ%ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿ þþ ûû õõ îîÜÜÀÀŸŸ#‡‡;mmWUUp@@‡**¢µ ËÞìöüÿÿÿ@ÿÿÿÿÿÿþùóéʬ”{l \ E 0 hhk——–ÒÒцÿþù~}}oùù7ÿÿ2ÿÿ+ÿÿ%ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ þþ ùù ðð ççÙÙÌ̳³'––3wwCRRb.. ›¼ Úåïöûÿÿÿÿÿÿÿÿÿü(öïå×Ƨ…eCH88T88I88C88=þš ××Ö××Ô××Ô××Öþöƒÿ~¹¹ºqqk|| ðð3ÿÿ/ÿÿ'ÿÿ ÿÿÿÿÿÿúúôô éé ××ÀÀ¨¨%’’7zzN``fFF..—­ ÅÜî÷ýÿÿÿÿÿÿÿÿÿÿùóæл£Šu^E.@@X{{†{{ü{zÄÄÁûûùûûúûûúûûú‚ÿóÿþù~aa\OOåå,ûû+öö"ïïççÚÚ¹¹!––'rrAVVa==‚..›¸Ë ÙçñúþÿÿÿÿÿÿÿÿÿúõîæË«ŠeK8J!!=!!3kkt¿¿Áü¿¼¿¿½ããâ‚ÿÛÿþù~}}€$%:ŸŸJƒƒVllaMMw11‹¤ ÄàñöüÿÿÿÿÿÿÿÿÿþùóåÕƲ˜}dE(<> stream ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿ‚ÿìÿ€ endstream endobj 16 0 obj 357 endobj 17 0 obj << /Title (logo) /CreationDate (D:20130423161413) /ModDate (D:20130423161413) /Producer (ImageMagick 6.6.9-7 2012-08-17 Q16 http://www.imagemagick.org) >> endobj xref 0 18 0000000000 65535 f 0000000010 00000 n 0000000059 00000 n 0000000118 00000 n 0000000300 00000 n 0000000383 00000 n 0000000401 00000 n 0000000439 00000 n 0000000460 00000 n 0000034048 00000 n 0000034069 00000 n 0000034096 00000 n 0000052644 00000 n 0000052666 00000 n 0000052682 00000 n 0000052704 00000 n 0000053254 00000 n 0000053274 00000 n trailer << /Size 18 /Info 17 0 R /Root 1 0 R >> startxref 53445 %%EOF gprolog-1.4.5/doc/use.tex0000644000175000017500000015713413021324543013415 0ustar spaspa\newpage \section{Using GNU Prolog} %HEVEA\cutdef[1]{subsection} \subsection{Introduction} \label{Introduction:(Using-GNU-Prolog)} GNU Prolog offers two ways to execute a Prolog program: \begin{itemize} \item interpreting it using the GNU Prolog interactive interpreter. \item compiling it to a (machine-dependent) executable using the GNU Prolog native-code compiler. \end{itemize} Running a program under the interactive interpreter allows the user to list it and to make full use of the debugger on it \RefSP{Debugging}. Compiling a program to native code makes it possible to obtain a stand alone executable, with a reduced size and optimized for speed. Running a Prolog program compiled to native-code is around 3-5 times faster than running it under the interpreter. However, it is not possible to make full use of the debugger on a program compiled to native-code. Nor is it possible to list the program. In general, it is preferable to run a program under the interpreter for debugging and then use the native-code compiler to produce an autonomous executable. It is also possible to combine these two modes by producing an executable that contains some parts of the program (e.g. already debugged predicates whose execution-time speed is crucial) and interpreting the other parts under this executable. In that case, the executable has the same facilities as the GNU Prolog interpreter but also integrates the native-code predicates. This way to define a new enriched interpreter is detailed later \RefSP{Generating-a-new-interactive-interpreter}. \subsection{The GNU Prolog interactive interpreter} \label{The-GNU-Prolog-interactive-interpreter} \subsubsection{Starting/exiting the interactive interpreter} \index{interpreter|see {top-level}} GNU Prolog offers a classical Prolog interactive interpreter also called \emph{top-level}. It allows the user to execute queries, to consult Prolog programs, to list them, to execute them and to debug them. The \IdxD{top-level} can be invoked using the following command: \OneLineTwoCols[5.5cm]{\% gprolog \textrm{[}\Param{OPTION}\textrm{]\ldots}}{(the \texttt{\%} symbol is the operating system shell prompt)} \SPart{Options}: \begin{CmdOptions} \IdxKD{--init-goal} \Param{GOAL} & execute \Param{GOAL} before entering the top-level \\ \IdxKD{--consult-file} \Param{FILE} & consult \Param{FILE} inside the top-level \\ \IdxKD{--entry-goal} \Param{GOAL} & execute \Param{GOAL} inside the top-level \\ \IdxKD{--query-goal} \Param{GOAL} & execute \Param{GOAL} as a query for the top-level \\ \IdxKD{--help} & print a help and exit \\ \IdxKD{--version} & print version number and exit \\ \IdxKD{--} & do not parse the rest of the command-line \\ \end{CmdOptions} The main role of the \texttt{gprolog} command is to execute the top-level itself, i.e. to execute the built-in predicate \IdxPB{top\_level/0} \RefSP{abort/0} which will produce something like: \begin{Code} \begin{verbatim} GNU Prolog 1.4.0 By Daniel Diaz Copyright (C) 1999-2015 Daniel Diaz | ?- \end{verbatim} \end{Code} The top-level is ready to execute your queries as explained in the next section. To quit the top-level type the end-of-file key sequence (\texttt{Ctl-D}) or its term representation: \texttt{end\_of\_file.} It is also possible to use the built-in predicate \IdxPB{halt/0} \RefSP{abort/0}. However, before entering the top-level itself, the command-line is processed to treat all known options (those listed above). All unrecognized arguments are collected together to form the argument list which will be available using \IdxPB{argument\_value/2} \RefSP{argument-value/2} or \IdxPB{argument\_list/1} \RefSP{argument-list/1}. The \texttt{--} option stops the parsing of the command-line, all remainding options are collected into the argument list. Several options are provided to execute a goal before entering the interaction with the user: \begin{itemize} \item The \texttt{--init-goal} option executes the \Param{GOAL} as soon as it is encountered (while the command-line is processed). \Param{GOAL} is thus executed before entering \texttt{top\_level/0}. \item The \texttt{--consult-file} option consults the \Param{FILE} at the entry of \texttt{top\_level/0} just after the banner is displayed. \texttt{--consult-file} options are handled before \texttt{--consult-file} options. \item The \texttt{--entry-goal} option executes the \Param{GOAL} at the entry of \texttt{top\_level/0} just after the banner is displayed. \item The \texttt{--query-goal} option executes the \Param{GOAL} as if the user has typed in (under the top-level). \end{itemize} The above order is thus the order in which each kind of goal (init, entry, query) is executed. If there are several goals of a same kind they are executed in the order of appearance. Thus, all init goals are executed (in the order of appearance) before all entry goals and all entry goals are executed before all query goals. Each \Param{GOAL} is passed as a shell argument (i.e. one shell string) and should not contain a terminal dot. Example: \texttt{--init-goal 'write(hello), nl'} under a sh-like. To be executed, a \Param{GOAL} is transformed into a term using \AddPB{read\_term\_from\_atom/3}\texttt{read\_term\_from\_atom(Goal, Term, [end\_of\_term(eof)])}. Respecting both the syntax of shell strings and of Prolog can be heavy. For instance, passing a backslash character \texttt{{\bs}} can be difficult since it introduces an \Idx{escape sequence} both in sh and inside Prolog quoted atoms. The use of back quotes can then be useful since, by default, no escape sequence is processed inside back quotes (this behavior can be controlled using the \IdxPF{back\_quotes} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}). Since the Prolog argument list is created when the whole command-line is parsed, if a \texttt{--init-goal} option uses \texttt{argument\_value/2} or \texttt{argument\_list/1} it will obtained the original command-line arguments (i.e. including all recognized arguments). Here is an example of using execution goal options: \begin{Code} \% gprolog --init-goal 'write(before), nl' --entry-goal 'write(inside), nl'\\ --query-goal 'append([a,b],[c,d],X)' \end{Code} will produce the following: \begin{Code} \begin{verbatim} before GNU Prolog 1.4.0 By Daniel Diaz Copyright (C) 1999-2015 Daniel Diaz inside | ?- append([a,b],[c,d],X). X = [a,b,c,d] yes | ?- \end{verbatim} \end{Code} NB: depending on the used shell it may be necessary to use other string delimiters (e.g. use \texttt{"} under Windows \texttt{cmd.exe}). \subsubsection{The interactive interpreter read-execute-write loop} The GNU Prolog top-level is built on a classical read-execute-write loop that also allows for re-executions (when the query is not deterministic) as follows: \begin{itemize} \item display the prompt, i.e. '\texttt{| ?-}'. \item read a query (i.e. a goal). \item execute the query. \item in case of success display the values of the variables of the query. \item if there are remaining alternatives (i.e. the query is not deterministic), display a \texttt{?} and ask the user who can use one of the following commands: \texttt{RETURN} to stop the execution, \texttt{;} to compute the next solution or \texttt{a} to compute all remaining solution. \end{itemize} Here is an example of execution of a query (``find the lists \texttt{X} and \texttt{Y} such that the concatenation of \texttt{X} and \texttt{Y} is \texttt{[a,b]}''): \begin{CodeTwoCols} \One{| ?- append(X,Y,[a,b,c]).} \SkipLine \One{X = []} \Two{Y = [a,b,c] ? ;}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \One{X = [a]} \Two{Y = [b,c] ? a}{(here the user presses \texttt{a} to compute all remaining solutions)} \SkipLine \One{X = [a,b]} \Two{Y = [c]} {(here the user is not asked and the next solution is computed)} \SkipLine \One{X = [a,b,c]} \Two{Y = []} {(here the user is not asked and the next solution is computed)} \SkipLine \Two{no}{(no more solution)} \end{CodeTwoCols} In some cases the top-level can detect that the current solution is the last one (no more alternatives remaining). In such a case it does not display the \texttt{?} symbol (and does not ask the user). Example: \begin{CodeTwoCols} \One{| ?- (X=1 ; X=2).} \SkipLine \Two{X = 1 ? ;}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = 2} {(here the user is not prompted since there are no more alternatives)} \SkipLine \One{yes} \end{CodeTwoCols} The user can stop the execution even if there are more alternatives by typing \texttt{RETURN}. \begin{CodeTwoCols} \One{| ?- (X=1 ; X=2).} \SkipLine \Two{X = 1 ?} {(here the user presses \texttt{RETURN} to stop the execution)} \SkipLine \One{yes} \end{CodeTwoCols} The top-level tries to display the values of the variables of the query in a readable manner. For instance, when a variable is bound to a query variable, the name of this variable appears. When a variable is a singleton an underscore symbol \texttt{\_} is displayed (\texttt{\_} is a generic name for a singleton variable, it is also called an anonymous variable). Other variables are bound to new brand variable names. When a query variable name \texttt{X} appears as the value of another query variable \texttt{Y} it is because \texttt{X} is itself not instantiated otherwise the value of \texttt{X} is displayed. In such a case, nothing is output for \texttt{X} itself (since it is a variable). Example: \begin{CodeTwoCols} \One{| ?- X=f(A,B,\_,A), A=k.} \SkipLine \Two{A = k} {(the value of \texttt{A} is displayed also in \texttt{f/3} for \texttt{X})} \Two{X = f(k,B,\_,k)} {(since \texttt{B} is a variable which is also a part of \texttt{X}, \texttt{B} is not displayed)} \end{CodeTwoCols} \begin{CodeTwoCols} \One{| ?- functor(T,f,3), arg(1,T,X), arg(3,T,X).} \SkipLine \Two{T = f(X,\_,X)} {(the 1$^{st}$ and 3$^{rd}$ args are equal to \texttt{X}, the 2$^{nd}$ is an anonymous variable)} \end{CodeTwoCols} \begin{CodeTwoCols} \One{| ?- read\_from\_atom('k(X,Y,X).',T).} \SkipLine \Two{T = k(A,\_,A)} {(the 1$^{st}$ and 3$^{rd}$ args are unified, a new variable name \texttt{A} is introduced)} \end{CodeTwoCols} The top-level uses variable binding predicates \RefSP{Variable-naming/numbering}. To display the value of a variable, the top-level calls \IdxPB{write\_term/3} with the following option list: \texttt{[\AddPO{quoted}\texttt{quoted(true)},\AddPO{numbervars}\texttt{numbervars(false)}, \AddPO{namevars}\texttt{namevars(true)}]} \RefSP{write-term/3}. A term of the form \texttt{'\$VARNAME'(Name)} where \texttt{Name} is an atom is displayed as a variable name while a term of the form \texttt{'\$VAR'(N)} where \texttt{N} is an integer is displayed as a normal compound term (such a term could be output as a variable name by \texttt{write\_term/3}). Example: \begin{CodeTwoCols} \One{| ?- X='\$VARNAME'('Y'), Y='\$VAR'(1).} \SkipLine \Two{X = Y} {(the term \texttt{'\$VARNAME'('Y')} is displayed as \texttt{Y})} \Two{Y = '\$VAR'(1)} {(the term \texttt{'\$VAR'(1)} is displayed as is)} \end{CodeTwoCols} \begin{CodeTwoCols} \One{| ?- X=Y, Y='\$VAR'(1).} \SkipLine \One{X = '\$VAR'(1)} \One{Y = '\$VAR'(1)} \end{CodeTwoCols} In the first example, \texttt{X} is explicitly bound to \texttt{'\$VARNAME'('Y')} by the query so the top-level displays \texttt{Y} as the value of \texttt{X}. \texttt{Y} is unified with \texttt{'\$VAR'(1)} so the top-level displays it as a normal compound term. It should be clear that \texttt{X} is not bound to \texttt{Y} (whereas it is in the second query). This behavior should be kept in mind when doing variable binding operations. Finally, the top-level computes the user-time \RefSP{user-time/1} taken by a query and displays it when it is significant. Example: \begin{CodeTwoCols} \One{| ?- retractall(p(\_)), assertz(p(0)),} \One{~~~~~repeat,} \One{~~~~~~~~retract(p(X)),} \One{~~~~~~~~Y is X + 1,} \One{~~~~~~~~assertz(p(Y)),} \One{~~~~~~~~X = 1000, !.} \SkipLine \One{X = 1000} \One{Y = 1001} \SkipLine \Two{(180 ms) yes}{(the query took 180ms of user time)} \end{CodeTwoCols} \subsubsection{Consulting a Prolog program} \label{Consulting-a-Prolog-program} The top-level allows the user to consult Prolog source files. Consulted predicates can be listed, executed and debugged (while predicates compiled to native-code cannot). For more information about the difference between a native-code predicate and a consulted predicate refer to the introduction of this section \RefSP{Introduction:(Using-GNU-Prolog)} and to the part devoted to the compiler \RefSP{Different-kinds-of-codes}. To consult a program use the built-in predicate \IdxPB{consult/1} \RefSP{consult/1}. The argument of this predicate is a Prolog file name or \texttt{user} to specify the terminal. This allows the user to directly input the predicates from the terminal. In that case the input shall be terminated by the end-of-file key sequence (\texttt{Ctl-D}) or its term representation: \texttt{end\_of\_file.} A shorthand for \texttt{consult(}\Param{FILE}\texttt{)} is \texttt{[}\Param{FILE}\texttt{]}. Example: \begin{CodeTwoCols} \One{| ?- [user].} \One{{\lb}compiling user for byte code...{\rb}} \One{even(0).} \One{even(s(s(X))):-} \One{~~~~~~~~even(X).} \Two{}{(here the user presses \texttt{Ctl-D} to end the input)} \One{{\lb}user compiled, 3 lines read - 350 bytes written, 1180 ms{\rb}} \SkipLine \One{| ?- even(X).} \SkipLine \Two{X = 0 ? ;}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = s(s(0)) ? ;}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = s(s(s(s(0)))) ?}{(here the user presses \texttt{RETURN} to stop the execution)} \SkipLine \One{yes} \One{| ?- listing.} \SkipLine \One{even(0).} \One{even(s(s(A))) :-} \One{~~~~~~~~even(A).} \end{CodeTwoCols} When \IdxPB{consult/1} \RefSP{consult/1} is invoked on a Prolog file it first runs the GNU Prolog compiler \RefSP{The-GNU-Prolog-compiler} as a child process to generate a temporary WAM file for byte-code. If the compilation fails a message is displayed and nothing is loaded. If the compilation succeeds, the produced file is loaded into memory using \IdxPB{load/1} \RefSP{load/1}. Namely, the byte-code of each predicate is loaded. When a predicate \Param{P} is loaded if there is a previous definition for \Param{P} it is removed (i.e. all clauses defining \Param{P} are erased). We say that \Param{P} is redefined. Note that only consulted predicates can be redefined. If \Param{P} is a native-code predicate, trying to redefine it will produce an error at load-time: the predicate redefinition will be ignored and the following message displayed: \OneLine{native code procedure \Param{P} cannot be redefined} Finally, an existing predicate will not be removed if it is not re-loaded. This means that if a predicate \Param{P} is loaded when consulting the file \Param{F}, and if later the definition of \Param{P} is removed from the file \Param{F}, consulting \Param{F} again will not remove the previously loaded definition of \Param{P} from the memory. Consulted predicates can be debugged using the Prolog debugger. Use the debugger predicate \IdxDB{trace/0} or \IdxDB{debug/0} \RefSP{Running-and-stopping-the-debugger} to activate the debugger. \subsubsection{Scripting Prolog} \label{Scripting-Prolog} Since version 1.4.0 it is possible to use a Prolog source file as a Unix script-file (\IdxD{shebang support}). A \IdxD{PrologScript} file should begin as follows: \begin{Code} \begin{verbatim} #!/usr/bin/gprolog --consult-file \end{verbatim} \end{Code} GNU Prolog will be invoked as \begin{Code} \begin{verbatim} /usr/bin/gprolog --consult-file FILE \end{verbatim} \end{Code} Then \texttt{FILE} will be consulted. In order to correctly deal with the \texttt{\#!} first line, \texttt{consult/1} treats as a comment a first line of a file which begins with \texttt{\#} (if you want to use a predicate name starting with a \texttt{\#}, simply skip a line before its definition). Remark: it is almost never possible to pass additionnal parameters (e.g. \texttt{query-goal}) this way since in most systems the shebang implementation deliver all arguments (following \texttt{\#!/usr/bin/gprolog}) as a single string (which cannot then correctly be recognized by \texttt{gprolog}). \subsubsection{Interrupting a query} \label{Interrupting-a-query} Under the top-level it is possible to interrupt the execution of a query by typing the interruption key (\texttt{Ctl-C}). This can be used to abort a query, to stop an infinite loop, to activate the debugger,\ldots When an interruption occurs the top-level displays the following message: \texttt{Prolog interruption (h for help)~?} The user can then type one of the following commands: \begin{tabular}{|c|c|l|} \hline Command & Name & Description \\ \hline\hline \texttt{a} & abort & abort the current execution. Same as \IdxPB{abort/0} \RefSP{abort/0} \\ \hline \texttt{e} & exit & quit the current Prolog process. Same as \IdxPB{halt/0} \RefSP{abort/0} \\ \hline \texttt{b} & break & invoke a recursive top-level. Same as \IdxPB{break/0} \RefSP{abort/0} \\ \hline \texttt{c} & continue & resume the execution \\ \hline \texttt{t} & trace & start the debugger using \IdxDB{trace/0} \RefSP{Running-and-stopping-the-debugger} \\ \hline \texttt{d} & debug & start the debugger using \IdxDB{debug/0} \RefSP{Running-and-stopping-the-debugger} \\ \hline \texttt{h} or \texttt{?} & help & display a summary of available commands \\ \hline \end{tabular} \subsubsection{The line editor} \label{The-line-editor} The line editor (\IdxKD{linedit}) allows the user to build/update the current input line using a variety of commands. This facility is available if the \texttt{linedit} part of GNU Prolog has been installed. \texttt{linedit} is implicitly called by any built-in predicate reading from a terminal (e.g. \texttt{get\_char/1}, \texttt{read/1},\ldots). This is the case when the \Idx{top-level} reads a query. \SPart{Bindings}: each command of \texttt{linedit} is activated using a key. For some commands another key is also available to invoke the command (on some terminals this other key may not work properly while the primary key always works). Here is the list of available commands: \begin{tabular}{|c|c|l|} \hline Key & Alternate key & Description \\ \hline\hline \texttt{Ctl-B} & \texttt{$\leftarrow$} & go to the previous character \\ \hline \texttt{Ctl-F} & \texttt{$\rightarrow$} & go to the next character \\ \hline \texttt{Esc-B} & \texttt{Ctl-$\leftarrow$} & go to the previous word \\ \hline \texttt{Esc-F} & \texttt{Ctl-$\rightarrow$} & go to the next word \\ \hline \texttt{Ctl-A} & \texttt{Home} & go to the beginning of the line \\ \hline \texttt{Ctl-E} & \texttt{End} & go to the end of the line \\ \hline \texttt{Ctl-H} & \texttt{Backspace} & delete the previous character \\ \hline \texttt{Ctl-D} & \texttt{Delete} & delete the current character \\ \hline \texttt{Ctl-U} & \texttt{Ctl-Home} & delete from beginning of the line to the current character \\ \hline \texttt{Ctl-K} & \texttt{Ctl-End} & delete from the current character to the end of the line \\ \hline \texttt{Esc-L} & & lower case the next word \\ \hline \texttt{Esc-U} & & upper case the next word \\ \hline \texttt{Esc-C} & & capitalize the next word \\ \hline \texttt{Ctl-T} & & exchange last two characters \\ \hline \texttt{Ctl-V} & \texttt{Insert} & switch on/off the insert/replace mode \\ \hline \texttt{Ctl-I} & \texttt{Tab} & complete word (twice displays all possible completions) \\ \hline \texttt{Esc-Ctl-I} & \texttt{Esc-Tab} & insert spaces to emulate a tabulation \\ \hline \texttt{Ctl-space} & & mark beginning of the selection \\ \hline \texttt{Esc-W} & & copy (from the begin selection mark to the current character) \\ \hline \texttt{Ctl-W} & & cut (from the begin selection mark to the current character) \\ \hline \texttt{Ctl-Y} & & paste \\ \hline \texttt{Ctl-P} & \texttt{$\uparrow$} & recall previous history line \\ \hline \texttt{Ctl-N} & \texttt{$\downarrow$} & recall next history line \\ \hline \texttt{Esc-P} & & recall previous history line beginning with the current prefix \\ \hline \texttt{Esc-N} & & recall next history line beginning with the current prefix \\ \hline \texttt{Esc-{\lt}} & \texttt{Page Up} & recall first history line \\ \hline \texttt{Esc-{\gt}} & \texttt{Page Down} & recall last history line \\ \hline \texttt{Ctl-C} & & generate an interrupt signal \RefSP{Interrupting-a-query} \\ \hline \texttt{Ctl-D} & & generate an end-of-file character (at the begin of the line) \\ \hline \texttt{RETURN} & & validate a line \\ \hline \texttt{Esc-?} & & display a summary of available commands \\ \hline \end{tabular} \SPart{History}: when a line is entered (i.e. terminated by \texttt{RETURN}), \texttt{linedit} records it in an internal list called history. It is later possible to recall history lines using appropriate commands (e.g. \texttt{Ctl-P} recall the last entered line) and to modify them as needed. It is also possible to recall a history line beginning with a given prefix. For instance to recall the previous line beginning with \texttt{write} simply type \texttt{write} followed by \texttt{Esc-P}. Another \texttt{Esc-P} will recall an earlier line beginning with \texttt{write},\ldots \SPart{Completion}: another important feature of \texttt{linedit} is its \IdxD{completion} facility. Indeed, \texttt{linedit} maintains a list of known words and uses it to complete the prefix of a word. Initially this list contains all predefined atoms and the atoms corresponding to available predicates. This list is dynamically updated when a new atom appears in the system (whether read at the top-level, created with a built-in predicate, associated with a new consulted predicate,\ldots). When the completion key (\texttt{Tab}) is pressed \texttt{linedit} acts as follows: \begin{itemize} \item use the current word as a prefix. \item collect all words of the list that begin with this prefix. \item complete the current word with the longest common part of all matching words. \item if more than one word matches emit a beep (a second \texttt{Tab} will display all possibilities). \end{itemize} Example: \begin{CodeTwoCols} \Two{| ?- argu} {(here the user presses \texttt{Tab} to complete the word)} \Two{| ?- argument\_}{(\texttt{linedit} completes \texttt{argu} with \texttt{argument\_} and emits a beep)} \Two{}{(the user presses again \texttt{Tab} to see all possible completions)} \Two{argument\_counter}{(\texttt{linedit} shows 3 possible completions)} \One{argument\_list} \One{argument\_value} \Two{| ?- argument\_}{(\texttt{linedit} redisplays the input line)} \SkipLine \Two{| ?- argument\_c}{(to select \texttt{argument\_counter} the user presses \texttt{c} and \texttt{Tab})} \Two{| ?- argument\_counter}{(\texttt{linedit} completes with \texttt{argument\_counter})} \end{CodeTwoCols} \SPart{Balancing}: \texttt{linedit} allows the user to check that (square/curly) brackets are well balanced. For this, when a close bracket symbol, i.e. \texttt{)}, \texttt{]} or \texttt{{\rb}}, is typed, \texttt{linedit} determines the associated open bracket, i.e. \texttt{(}, \texttt{[} or \texttt{{\lb}}, and temporarily repositions the cursor on it to show the match. \SPart{Customization}: the behavior of \texttt{linedit} can be controlled via an environment variable called \texttt{LINEDIT}. This variable can contain the following substrings: \begin{tabular}{ll} \texttt{no} & do not activated linedit (should the only value of the variable) \\ \texttt{ansi=no} & do not use ANSI escape sequence (unix only) \\ \texttt{out=}$N$ & use the file descriptor $N$ for the output (unix only) \\ \texttt{gui=no} & even if compiled with the \Idx{GUI console} run in text mode (windows) \\ \texttt{gui=silent} & if the \Idx{GUI console} is not found, silently run in text mode (windows) \\ \texttt{cp=}$N$ & use code page $N$ (windows text console) \\ \texttt{oem\_put=no} & do not use Char$\rightarrow$Oem conversion when emitting a char (windows text console) \\ \texttt{oem\_get=no} & do not use Oem$\rightarrow$Char conversion when reading a char (windows text console) \\ \end{tabular} \subsection{Adjusting the size of Prolog data} \label{Adjusting-the-size-of-Prolog-stacks} GNU Prolog uses several stacks to execute a Prolog program. Each stack has a static size and cannot be dynamically increased during the execution. For each stack there is a default size but the user can define a new size by setting an environment variable. When a GNU Prolog program is run it first consults these variables and if they are not defined uses the default sizes. The following table presents each stack of GNU Prolog with its default size and the name of its associated environment variable: Since version 1.4.2, the size of the atom table (the table recording all atoms) is managed similarly to stacks. It is then included in the following table (even if actually it is not a stack but an hash table). In this table, the associated name is \texttt{atoms} which is the key used in statistics \RefSP{statistics/2}. The environment variable name is derived from the corresponding Prolog flag \texttt{max\_atom}, see \RefSP{set-prolog-flag/2}. \begin{tabular}{|c|c|c|l|} \hline Stack & Default & Environment & Description \\ name & size (Kb) & variable & \\ \hline\hline \texttt{local} & 16384 & \texttt{LOCALSZ} & control stack (environments and choice-points) \\ \hline \texttt{global} & 32768 & \texttt{GLOBALSZ} & heap (compound terms) \\ \hline \texttt{trail} & 16384 & \texttt{TRAILSZ} & conditional bindings (bindings to undo at backtracking) \\ \hline \texttt{cstr} & 16384 & \texttt{CSTRSZ} & finite domain constraint stack (FD variables and constraints) \\ \hline \texttt{atoms} & 32768 & \texttt{MAX\_ATOM} & atom table \\ \hline \end{tabular} In addition, under Windows (since version 1.4.0), registry keys are consulted (key names are the same as environment names). The keys are stored in \texttt{HKEY\_CURRENT\_USER{\bs}Software{\bs}GnuProlog{\bs}}. If the size of a stack is too small an overflow will occur during the execution. In that case GNU Prolog emits the following error message before stopping: \OneLine{\Param{S} stack overflow (size:~\Param{N} Kb, environment variable used:~\Param{E})} where \Param{S} is the name of the stack, \Param{N} is the current stack size in Kb and \Param{E} the name of the associated environment variable. When such a message occurs it is possible to (re)define the variable \Param{E} with the new size. For instance to allocate Kb to the local stack under a Unix shell use: \begin{CodeTwoCols}[6cm] \Two{LOCALSZ=32768; export LOCALSZ}{(under \texttt{sh} or \texttt{bash})} \Two{setenv LOCALSZ 32768}{(under \texttt{csh} or \texttt{tcsh})} \end{CodeTwoCols} This method allows the user to adjust the size of Prolog stacks. However, in some cases it is preferable not to allow the user to modify these sizes. For instance, when providing a stand alone executable whose behavior should be independent of the environment in which it is run. In that case the program should not consult environment variables and the programmer should be able to define new default stack sizes. The GNU Prolog compiler offers this facilities via several command-line options such as \IdxK{--local-size} or \IdxK{--fixed-sizes} \RefSP{Using-the-compiler}. Finally note that GNU Prolog stacks are virtually allocated (i.e. use virtual memory). This means that a physical memory page is allocated only when needed (i.e. when an attempt to read/write it occurs). Thus it is possible to define very large stacks. At the execution, only the needed amount of space will be physically allocated. \subsection{The GNU Prolog compiler} \label{The-GNU-Prolog-compiler} \subsubsection{Different kinds of codes} \label{Different-kinds-of-codes} One of the main advantages of GNU Prolog is its ability to produce stand alone executables. A Prolog program can be compiled to native code to give rise to a machine-dependent executable using the GNU Prolog compiler. However native-code predicates cannot be listed nor fully debugged. So there is an alternative to native-code compilation: byte-code compilation. By default the GNU Prolog compiler produces native-code but via a command-line option it can produce a file ready for byte-code loading. This is exactly what \IdxPB{consult/1} does as was explained above \RefSP{Consulting-a-Prolog-program}. GNU Prolog also manages interpreted code using a Prolog interpreter written in Prolog. Obviously interpreted code is slower than byte-code but does not require the invocation of the GNU Prolog compiler. This interpreter is used each time a meta-call is needed as by \texttt{call/1} \RefSP{call/1}. This also the case of dynamically asserted clauses. The following table summarizes these three kinds of codes: \begin{tabular}{|l|l|c|l|} \hline Type & Speed & Debug ? & For what \\ \hline\hline interpreted-code & slow & yes & meta-call and dynamically asserted clauses \\ \hline byte-code & medium & yes & consulted predicates \\ \hline native-code & fast & no & compiled predicates \\ \hline \end{tabular} \subsubsection{Compilation scheme} \label{Compilation-scheme} \SPart{Native-code compilation}: a Prolog source is compiled in several stages to produce an object file that is linked to the GNU Prolog libraries to produce an executable. The Prolog source is first compiled to obtain a \Idx{WAM} \cite{Warren83} file. For a detailed study of the WAM the interested reader can refer to \MyUrl{http://www.isg.sfu.ca/\~{}hak/documents/wam.html}{``Warren's Abstract Machine: A Tutorial Reconstruction''} \cite{Ait-Kaci91}. The WAM file is translated to a machine-independent language specifically designed for GNU Prolog. This language is close to a (universal) assembly language and is based on a very reduced instruction set. For this reason this language is called \IdxD{mini-assembly} (\IdxD{MA}). The mini-assembly file is then mapped to the assembly language of the target machine. This assembly file is assembled to give rise to an object file which is then linked with the GNU Prolog libraries to provide an executable. The compiler also takes into account Finite Domain constraint definition files. It translates them to C and invoke the C compiler to obtain object files. The following figure presents this compilation scheme: \InsertImage{compil-scheme} Obviously all intermediate stages are hidden to the user who simply invokes the compiler on his Prolog file(s) (plus other files: C,\ldots) and obtains an executable. However, it is also possible to stop the compiler at any given stage. This can be useful, for instance, to see the \Idx{WAM} code produced (perhaps when learning the WAM). Finally it is possible to give any kind of file to the compiler which will insert it in the compilation chain at the stage corresponding to its type. The type of a file is determined using the suffix of its file name. The following table presents all recognized types/suffixes: \begin{tabular}{|l|l|l|} \hline Suffix of the file & Type of the file & Handled by: \\ \hline\hline \texttt{.pl}, \texttt{.pro}, \texttt{.prolog} & Prolog source file & \texttt{pl2wam} \\ \hline \texttt{.wam} & WAM source file & \texttt{wam2ma} \\ \hline \texttt{.ma} & Mini-assembly source file & \texttt{ma2asm} \\ \hline \texttt{.s} & Assembly source file & the assembler \\ \hline \texttt{.c}, \texttt{.C}, \texttt{.CC}, \texttt{.cc}, \texttt{.cxx}, \texttt{.c++}, \texttt{.cpp} & C or C++ source file & the C compiler \\ \hline \texttt{.fd} & Finite Domain constraint source file & \texttt{fd2c} \\ \hline any other suffix (\texttt{.o}, \texttt{.a},\ldots) & any other type (object, library,\ldots) & the linker (C linker) \\ \hline \end{tabular} \SPart{Byte-code compilation}: the same compiler can be used to compile a source Prolog file for byte-code. In that case the Prolog to WAM compiler is invoked using a specific option and produces a WAM for byte-code source file (suffixed \texttt{.wbc}) that can be later loaded using \IdxPB{load/1} \RefSP{load/1}. Note that this is exactly what \IdxPB{consult/1} \RefSP{consult/1} does as explained above \RefSP{Consulting-a-Prolog-program}. \subsubsection{Using the compiler} \label{Using-the-compiler} The GNU Prolog compiler is a command-line compiler similar in spirit to a Unix C compiler like \texttt{gcc}. To invoke the compiler use the \IdxKD{gplc} command as follows: \OneLineTwoCols[5.5cm]{\% gplc \textrm{[}\Param{OPTION}\textrm{]\ldots}~\Param{FILE}\textrm{\ldots}}{(the \texttt{\%} symbol is the operating system shell prompt)} The arguments of \texttt{gplc} are file names that are dispatched in the compilation scheme depending on the type determined from their suffix as was explained previously \RefSP{Compilation-scheme}. All object files are then linked to produce an executable. Note however that GNU Prolog has no module facility (since there is not yet an ISO reference for Prolog modules) thus a predicate defined in a Prolog file is visible from any other predicate defined in any other file. GNU Prolog allows the user to split a big Prolog source into several files but does not offer any way to hide a predicate from others. The simplest way to obtain an executable from a Prolog source file \texttt{prog.pl} is to use: \OneLine{\% gplc prog.pl} This will produce an native executable called \texttt{prog} which can be executed as follows: \OneLine{\% prog} However, there are several options that can be used to control the compilation: \SPart{General options}: \begin{CmdOptions} \IdxKD{-o} \Param{FILE}, \IdxKD{--output} \Param{FILE} & use \Param{FILE} as the name of the output file \\ \IdxKD{-W}, \IdxKD{--wam-for-native} & stop after producing WAM files(s) \\ \IdxKD{-w}, \IdxKD{--wam-for-byte-code} & stop after producing WAM for byte-code file(s) (force \texttt{--no-call-c}) \\ \IdxKD{-M}, \IdxKD{--mini-assembly} & stop after producing mini-assembly files(s) \\ \IdxKD{-S}, \IdxKD{--assembly} & stop after producing assembly files (s) \\ \IdxKD{-F}, \IdxKD{--fd-to-c} & stop after producing C files(s) from FD constraint definition file(s) \\ \IdxKD{-c}, \IdxKD{--object} & stop after producing object files(s) \\ \IdxKD{--temp-dir} \Param{PATH} & use \Param{PATH} as directory for temporary files \\ \IdxKD{--no-del-temp} & do not delete temporary files \\ \IdxKD{--no-demangling} & do not decode predicate names (name demangling) \\ \IdxKD{-v}, \IdxKD{--verbose} & print executed commands \\ \IdxKD{-h}, \IdxKD{--help} & print a help and exit \\ \IdxKD{--version} & print version number and exit \\ \end{CmdOptions} \SPart{Prolog to WAM compiler options}: \begin{CmdOptions} \IdxKD{--pl-state} \Param{FILE} & read \Param{FILE} to set the initial Prolog state \\ \IdxKD{--wam-comment} \Param{COMMENT} & emit \Param{COMMENT} as a comment in the WAM file \\ \IdxKD{--no-susp-warn} & do not show warnings for suspicious predicates \\ \IdxKD{--no-singl-warn} & do not show warnings for named singleton variables \\ \IdxKD{--no-redef-error} & do not show errors for built-in predicate redefinitions \\ \IdxKD{--foreign-only} & only compile \texttt{foreign/1-2} directives \\ \IdxKD{--no-call-c} & do not allow the use of \texttt{fd\_tell}, \texttt{'\$call\_c}',\ldots \\ \IdxKD{--no-inline} & do not inline predicates \\ \IdxKD{--no-reorder} & do not reorder predicate arguments \\ \IdxKD{--no-reg-opt} & do not optimize registers \\ \IdxKD{--min-reg-opt} & minimally optimize registers \\ \IdxKD{--no-opt-last-subterm} & do not optimize last subterm compilation \\ \IdxKD{--fast-math} & use fast mathematical mode (assume integer arithmetics) \\ \IdxKD{--keep-void-inst} & keep void WAM instructions in the output file \\ \IdxKD{--compile-msg} & print a compile message \\ \IdxKD{--statistics} & print statistics information \\ \end{CmdOptions} \SPart{WAM to mini-assembly translator options}: \begin{CmdOptions} \IdxKD{--comment} & include comments in the output file \\ \end{CmdOptions} \SPart{Mini-assembly to assembly translator options}: \begin{CmdOptions} \IdxK{--comment} & include comments in the output file \\ \end{CmdOptions} \SPart{C compiler options}: \begin{CmdOptions} \IdxKD{--c-compiler} \Param{FILE} & use \Param{FILE} as C compiler/linker \\ \IdxKD{-C} \Param{OPTION} & pass \Param{OPTION} to the C compiler \\ \end{CmdOptions} \SPart{Assembler options}: \begin{CmdOptions} \IdxKD{-A} \Param{OPTION} & pass \Param{OPTION} to the assembler \\ \end{CmdOptions} \SPart{Linker options}: \begin{CmdOptions} \IdxKD{--linker} \Param{FILE} & use \Param{FILE} as linker \\ \IdxKD{--local-size} \Param{N} & set default local stack size to \Param{N} Kb \\ \IdxKD{--global-size} \Param{N} & set default global stack size to \Param{N} Kb \\ \IdxKD{--trail-size} \Param{N} & set default trail stack size to \Param{N} Kb \\ \IdxKD{--cstr-size} \Param{N} & set default constraint stack size to \Param{N} Kb \\ \IdxKD{--max-atom} \Param{N} & set default atom table size to \Param{N} atoms \\ \IdxKD{--fixed-sizes} & do not consult environment variables at run-time (use default sizes) \\ \IdxKD{--gui-console} & link with the \Idx{GUI console} (windows only)\\ \IdxKD{--no-top-level} & do not link the \Idx{top-level} (force \IdxK{--no-debugger}) \\ \IdxKD{--no-debugger} & do not link the Prolog/WAM debugger \\ \IdxKD{--min-pl-bips} & link only used Prolog built-in predicates \\ \IdxKD{--min-fd-bips} & link only used FD solver built-in predicates \\ \IdxKD{--min-bips} & shorthand for: \texttt{--no-top-level} \texttt{--min-pl-bips} \texttt{--min-fd-bips} \\ \IdxKD{--min-size} & shorthand for: \texttt{--min-bips} \texttt{--strip} \\ \IdxKD{--no-fd-lib} & do not look for the FD library (maintenance only) \\ \IdxKD{-s}, \IdxKD{--strip} & strip the executable \\ \IdxKD{-L} \Param{OPTION} & Pass \Param{OPTION} to the linker \\ \end{CmdOptions} It is possible to only give the prefix of an option if there is no ambiguity. The name of the output file is controlled via the \texttt{-o} \Param{FILE} option. If present the output file produced will be named \Param{FILE}. If not specified, the output file name depends on the last stage reached by the compiler. If the link is not done the output file name(s) is the input file name(s) with the suffix associated with the last stage. If the link is done, the name of the executable is the name (without suffix) of the first file name encountered in the command-line. Note that if the link is not done \texttt{-o} has no sense in the presence of multiple input file names. For this reason, several meta characters are available for substitution in \Param{FILE}: \begin{itemize} \item \texttt{\%f} is substitued by the whole input file name. \item \texttt{\%F} is similar to \texttt{\%f} but the directory part is omitted. \item \texttt{\%p} is substitued by the whole prefix file name (omitting the suffix). \item \texttt{\%P} is similar to \texttt{\%p} but the directory part is omitted. \item \texttt{\%s} is substitued by the file suffix (including the dot). \item \texttt{\%d} is substitued by the directory part (empty if no directory is specified). \item \texttt{\%c} is substitued by the value of an internal counter starting from 1 and auto-incremented. \end{itemize} By default the compiler runs in the native-code compilation scheme. To generate a WAM file for byte-code use the \texttt{--wam-for-byte-code} option. The resulting file can then be loaded using \IdxPB{load/1} \RefSP{load/1}. To execute the Prolog to WAM compiler in a given \emph{read environment} (operator definitions, character conversion table,\ldots) use \texttt{--pl-state} \Param{FILE}. The state file should be produced by \IdxPB{write\_pl\_state\_file/1} \RefSP{write-pl-state-file/1}. By default the Prolog to WAM compiler inlines calls to some deterministic built-in predicates (e.g. \texttt{arg/3} and \texttt{functor/3}). Namely a call to such a predicate will not yield a classical predicate call but a simple C function call (which is obviously faster). It is possible to avoid this using \texttt{--no-inline}. Another optimization performed by the Prolog to WAM compiler is unification reordering. The arguments of a predicate are reordered to optimize unification. This can be deactivated using \texttt{--no-reorder}. The compiler also optimizes the unification/loading of nested compound terms. More precisely, the compiler emits optimized instructions when the last subterm of a compound term is itself a compound term (e.g. lists). This can be deactivated using \texttt{--no-opt-last-subterm}. By default the Prolog to WAM compiler fully optimizes the allocation of registers to decrease both the number of instruction produced and the number of used registers. A good allocation will generate many \emph{void instructions} that are removed from the produced file except if \texttt{--keep-void-inst} is specified. To prevent any optimization use \texttt{--no-reg-opt} while \texttt{--min-reg-opt} forces the compiler to only perform simple register optimizations. The Prolog to WAM compiler emits an error when a control construct or a built-in predicate is redefined. This can be avoided using \texttt{--no-redef-error}. The compiler also emits warnings for suspicious predicate definitions like \texttt{-/2} since this often corresponds to an earlier syntax error (e.g. \texttt{-} instead of \texttt{\_}. This can be deactivated by specifying \texttt{--no-susp-warn}. Finally, the compiler warns when a singleton variable has a name (i.e. not the generic anonymous name \texttt{\_}). This can be deactivated specifying \texttt{--no-singl-warn}. Internally, predicate names are encoded to fit the syntax of (assembly) identifiers. For this GNU Prolog uses it own \Idx{name mangling} scheme. This is explained in more detail later \RefSP{Name-mangling-scheme}. By default the error messages from the linker (e.g. multiple definitions for a given predicate, reference to an undefined predicate,\ldots) are filtered to replace an internal name representation by the real predicate name (\Idx{demangling}). Specifying the \texttt{--no-demangling} prevents \IdxK{gplc} from filtering linker output messages (internal identifiers are then shown). When producing an executable it is possible to specify default stack sizes (using \texttt{--\Param{STACK\_NAME}-size}) and to prevent it from consulting environment variables (using \texttt{--fixed-sizes}) as was explained above \RefSP{Adjusting-the-size-of-Prolog-stacks}. By default the produced executable will include the top-level, the Prolog/WAM debugger and all Prolog and FD built-in predicates. It is possible to avoid linking the top-level \RefSP{The-GNU-Prolog-interactive-interpreter} by specifying \texttt{--no-top-level}. In this case, at least one \IdxDi{initialization/1} directive \RefSP{initialization/1} should be defined. The option \texttt{--no-debugger} does not link the debugger. To include only used built-in predicates that are actually used the options \texttt{--no-pl-bips} and/or \texttt{--no-fd-bips} can be specified. For the smallest executable all these options should be specified. This can be abbreviated by using the shorthand option \texttt{--min-bips}. By default, executables are not \emph{stripped}, i.e. their symbol table is not removed. This table is only useful for the C debugger (e.g. when interfacing Prolog and C). To remove the symbol table (and then to reduce the size of the final executable) use \texttt{--strip}. Finally \texttt{--min-size} is a shortcut for \texttt{--min-bips} and \texttt{--strip}, i.e. the produced executable is as small as possible. Example: compile and link two Prolog sources \texttt{prog1.pl} and \texttt{prog2.pl}. The resulting executable will be named \texttt{prog1} (since \texttt{-o} is not specified): \OneLine{\% gplc prog1.pl prog2.pl} Example: compile the Prolog file \texttt{prog.pl} to study basic WAM code. The resulting file will be named \texttt{prog.wam}: \OneLine{\% gplc -W --no-inline --no-reorder --keep-void-inst prog.pl} Example: compile the Prolog file \texttt{prog.pl} and its C interface file \texttt{utils.c} to provide an autonomous executable called \texttt{mycommand}. The executable is not stripped to allow the use of the C debugger: \OneLine{\% gplc -o mycommand prog.pl utils.c} Example: detail all steps to compile the Prolog file \texttt{prog.pl} (the resulting executable is stripped). All intermediate files are produced (\texttt{prog.wam}, \texttt{prog.ma}, \texttt{prog.s}, \texttt{prog.o} and the executable \texttt{prog}): \begin{Indentation} \begin{verbatim} % gplc -W prog.pl % gplc -M --comment prog.wam % gplc -S --comment prog.ma % gplc -c prog.s % gplc -o prog -s prog.o \end{verbatim} \end{Indentation} \subsubsection{Running an executable} \label{Running-an-executable} In this section we explain what happens when running an executable produced by the GNU Prolog native-code compiler. The default main function first starts the Prolog engine. This function collects all linked objects (issued from the compilation of Prolog files) and initializes them. The initialization of a Prolog object file consists in adding to appropriate tables new atoms, new predicates and executing its system directives. A system directive is generated by the Prolog to WAM compiler to reflect a (user) directive executed at compile-time such as \texttt{op/3} \RefSP{op/3}. Indeed, when the compiler encounters such a directive it immediately executes it and also generates a system directive to execute it at the start of the executable. When all system directives have been executed the Prolog engine executes all initialization directives defined with \IdxDi{initialization/1} \RefSP{initialization/1}. If several initialization directives appear in the same file they are executed in the order of appearance. If several initialization directives appear in different files the order in which they are executed is machine-dependant. However, on most machines the order will be the reverse order in which the associated files have been linked (this is not true under native win32). When all initialization directives have been executed the default main function looks for the GNU Prolog \Idx{top-level}. If present (i.e. it has been linked) it is called otherwise the program simply ends. Note that if the top-level is not linked and if there is no initialization directive the program is useless since it simply ends without doing any work. The default main function detects such a behavior and emits a warning message. Example: compile an empty file \texttt{prog.pl} without linking the top-level and execute it: \begin{Indentation} \begin{verbatim} % gplc --no-top-level prog.pl % prog Warning: no initial goal executed use a directive :- initialization(Goal) or remove the link option --no-top-level (or --min-bips or --min-size) \end{verbatim} \end{Indentation} \subsubsection{Generating a new interactive interpreter} \label{Generating-a-new-interactive-interpreter} In this section we show how to define a new \Idx{top-level} extending the GNU Prolog interactive interpreter with new predicate definitions. The obtained top-level can then be considered as an enriched version of the basic GNU Prolog top-level \RefSP{The-GNU-Prolog-interactive-interpreter}. Indeed, each added predicate can be viewed as a predefined predicate just like any other built-in predicate. This can be achieved by compiling these predicates and including the top-level at link-time. The real question is: why would we include some predicates in a new top-level instead of simply consulting them under the GNU Prolog top-level ? There are two reasons for this: \begin{itemize} \item the predicate cannot be consulted. This is the case of a predicate calling foreign code, like a predicate interfacing with C \RefSP{Interfacing-Prolog-and-C} or a predicate defining a new FD constraint. \item the performance of the predicate is crucial. Since it is compiled to native-code such a predicate will be executed very quickly. Consulting will load it as byte-code. The gain is much more noticeable if the program is run under the debugger. The included version will not be affected by the debugger while the consulted version will be several times slower. Obviously, a predicate should be included in a new top-level only when it is itself debugged since it is difficult to debug native-code. \end{itemize} To define a new top-level simply compile the set of desired predicates and linking them with the GNU Prolog top-level (this is the default) using \IdxK{gplc} \RefSP{Using-the-compiler}. Example: let us define a new top-level called \texttt{my\_top\_level} including all predicates defined in \texttt{prog.pl}: \OneLine{\% gplc -o my\_top\_level prog.pl} By the way, note that if \texttt{prog.pl} is an empty Prolog file the previous command will simply create a new interactive interpreter similar to the GNU Prolog top-level. Example: as before where some predicates of \texttt{prog.pl} call C functions defined in \texttt{utils.c}: \OneLine{\% gplc -o my\_top\_level prog.pl utils.c} In conclusion, defining a particular top-level is nothing else but a particular case of the native-code compilation. It is simple to do and very useful in practice. \subsubsection{The name mangling scheme} \label{Name-mangling-scheme} When the GNU Prolog compiler compiles a Prolog source to an object file it has to associate a symbol to each predicate name. However, the syntax of symbols is restricted to identifiers: string containing only letters, digits or underscore characters. On the other hand, predicate names (i.e. atoms) can contain any character with quotes if necessary (e.g. \texttt{'x+y=z'} is a valid predicate name). The compiler may thus have to encode predicate names respecting the syntax of identifiers. In addition, Prolog allows the user to define several predicates with the same name and different arities, for this GNU Prolog encodes predicate indicators (predicate name followed by the arity). Finally, to support modules in the future, the module name is also encoded. Since version 1.4.0, GNU Prolog adopts the following \IdxD{name mangling} scheme. A predicate indicator of the form [\Param{MODULE}\texttt{:}]\Param{PRED}\texttt{/}\Param{N} (where the \Param{MODULE} can be omitted) will give rise to an identifier of the following form: \texttt{X}\Param{K}\texttt{\_}[\textit{E(\Param{MODULE})}\texttt{\_\_}]\textit{E(\Param{PRED})}\texttt{\_\_a}\Param{N} where: \begin{description} \item \Param{K} is a digit in \texttt{0}..\texttt{5} storing coding information about \Param{MODULE} and \Param{PRED}. Possible values are: \begin{itemize} \item \texttt{0}: no module present, \Param{PRED} is not encoded \item \texttt{1}: no module present, \Param{PRED} is encoded \item \texttt{2}: \Param{MODULE} is not encoded, \Param{PRED} is not encoded \item \texttt{3}: \Param{MODULE} is not encoded, \Param{PRED} is encoded \item \texttt{4}: \Param{MODULE} is encoded, \Param{PRED} is not encoded \item \texttt{5}: \Param{MODULE} is encoded, \Param{PRED} is encoded \end{itemize} \item \textit{E(\Param{STR})} is a function to encode a string \Param{STR} which returns: \begin{itemize} \item \Param{STR} itself (not encoded) if \Param{STR} only contains letters, digits or \texttt{\_} but does not contain the substring \texttt{\_\_} and does not begin nor end with \texttt{\_} (i.e. regexp: \texttt{[a-zA-Z0-9]([-]?[a-zA-Z0-9])*}). \item an hexadecimal representation of each character of the string otherwise. For example: \textit{E(}\texttt{x+y=z}\textit{)} returns \texttt{782B793D7A} since \texttt{78} is the hexadecimal representation of the ASCII code of \texttt{x}, \texttt{2B} of the code of \texttt{+}, etc. \end{itemize} \end{description} Examples: \begin{center} \begin{tabular}{l|l} Predicate indicator & internal identifier \\ \hline \texttt{father/2} & \texttt{X0\_father\_\_a2} \\ \texttt{'x+y=z'/3} & \texttt{X1\_782B793D7A\_\_a3} \\ \texttt{util:same/2} & \texttt{X2\_util\_\_same\_\_a2} \\ \texttt{util:same\_\_1/3} & \texttt{X3\_util\_\_73616D655F5F31\_\_a3} \\ \end{tabular} \end{center} ~\BL So, from the \Idx{mini-assembly} stage, each predicate indicator is handled via its name mangling identifier. The knowledge of this scheme is normally not of interest for the user, i.e. the Prolog programmer. For this reason the GNU Prolog compiler hides this mangling. When an error occurs on a predicate (undefined predicate, predicate with multiple definitions,\ldots) the compiler has to decode the symbol associated with the predicate indicator (\IdxD{name demangling}). For this \IdxK{gplc} filters each message emitted by the linker to locate and decode eventual predicate indicators. This filtering can be deactivated specifying \texttt{--no-demangling} when invoking \IdxK{gplc} \RefSP{Using-the-compiler}. This filter is provided as an utility that can be invoked using the \IdxKD{hexgplc} command as follows: \OneLineTwoCols[5.5cm]{\% hexgplc \textrm{[}\Param{OPTION}\textrm{]\ldots}~\Param{FILE}\textrm{\ldots}}{(the \texttt{\%} symbol is the operating system shell prompt)} \SPart{Options}: \begin{CmdOptions} \IdxKD{--decode} or \IdxKD{--demangling} & decoding mode (this is the default mode) \\ \IdxKD{--encode} or \IdxKD{--mangling} & encoding mode \\ \IdxKD{--relax} & decode also predicate names (not only predicate indicators) \\ \IdxKD{--printf} \Param{FORMAT} & pass encoded/decoded string to C \texttt{printf(3)} with \Param{FORMAT} \\ \IdxKD{--aux-father} & decode an auxiliary predicate as its father \\ \IdxKD{--aux-father2} & decode an auxiliary predicate as its father + auxiliary number \\ \IdxKD{--cmd-line} & encode/decode each argument of the command-line \\ \IdxKD{-E} or \IdxKD{-M} & same as: \texttt{--cmd-line --encode --relax} \\ \IdxKD{-P} or \IdxKD{-D} & same as: \texttt{--cmd-line --decode --relax --quote} \\ \IdxKD{--help} & print a help and exit \\ \IdxKD{--version} & print version number and exit \\ \end{CmdOptions} It is possible to give a prefix of an option if there is no ambiguity. Without arguments \texttt{hexgplc} runs in decoding mode reading its standard input and decoding (demangling) each symbol corresponding to a predicate indicator. To use \texttt{hexgplc} in the encoding (mangling) mode the \texttt{--encode} option must be specified. By default \texttt{hexgplc} only decodes predicate indicators, this can be relaxed using \texttt{--relax} to also take into account simple predicate names (the arity can be omitted). It is possible to format the output of an encoded/decoded string using \texttt{--printf \Param{FORMAT}} in that case each string \Param{S} is passed to the C \texttt{printf(3)} function as \texttt{printf(\Param{FORMAT},\Param{S})}. Auxiliary predicates are generated by the Prolog to WAM compiler when simplifying some control constructs like \texttt{';'/2} present in the body of a clause. They are of the form \texttt{'\$\Param{NAME}/\Param{ARITY}\_\$aux\Param{N}'} where \texttt{\Param{NAME}/\Param{ARITY}} is the predicate indicator of the simplified (i.e. father) predicate and \Param{N} is a sequential number (a predicate can give rise to several auxiliary predicates). It is possible to force \texttt{hexgplc} to decode an auxiliary predicate as its father predicate indicator using \texttt{--aux-father} or as its father predicate indicator followed by the sequential number using \texttt{--aux-father2}. If no file is specified, \texttt{hexgplc} processes its standard input otherwise each file is treated sequentially. Specifying the \texttt{--cmd-line} option informs \texttt{hexgplc} that each argument is not a file name but a string that must be encoded (or decoded). This is useful to encode/decode a particular string. For this reason the option \texttt{-E} (encode) and \texttt{-D} (decode) are provided as shorthand. Then, to obtain the mangling representation of a predicate \Param{PRED} use: \OneLine{\% hexgplc -E \Param{PRED}} NB: if \Param{PRED} is a complex atom it is necessary to quote it (the quotes must be passed to \texttt{hexgplc}). Here is an example under bash: \begin{Indentation} \begin{verbatim} % hexgplc -E \'x+y=z\'/3 X1_782B793D7A__a3 \end{verbatim} \end{Indentation} Or even more safely (using bash quotes to prevent bash from interpreting special characters): \begin{Indentation} \begin{verbatim} % hexgplc -E \''x+y=z'\'/3 X1_782B793D7A__a3 \end{verbatim} \end{Indentation} %HEVEA\cutend gprolog-1.4.5/doc/copyright.tex0000644000175000017500000000004413021324543014614 0ustar spaspaCopyright (C) 1999-2015 Daniel Diaz gprolog-1.4.5/doc/fd-cstr.tex0000644000175000017500000013004013021324543014146 0ustar spaspa\newpage \section{Finite domain solver and built-in predicates} %HEVEA\cutdef[1]{subsection} \subsection{Introduction} \label{Intro-FD} The finite domain (FD) constraint solver extends Prolog with constraints over FD. This facility is available if the FD part of GNU Prolog has been installed. The solver is an instance of the Constraint Logic Programming scheme introduced by Jaffar and Lassez in 1987 \cite{Jaffar-Lassez87}. Constraints on FD are solved using propagation techniques, in particular arc-consistency (AC). The interested reader can refer to ``Constraint Satisfaction in Logic Programming'' of P. Van Hentenryck (1989) \cite{pvh89}. The solver is based on the \texttt{clp(FD)} solver \cite{long-clp-fd}. The GNU Prolog FD solver offers arithmetic constraints, boolean constraints, reified constraints and symbolic constraints on an new kind of variables: Finite Domain variables. \subsubsection{Finite Domain variables} \label{Finite-Domain-variables} A new type of data is introduced: FD variables which can only take values in their domains. The initial domain of an FD variable is \texttt{0..fd\_max\_integer} where \IdxFKD{fd\_max\_integer} represents the greatest value that any FD variable can take. The predicate \texttt{fd\_max\_integer/1} returns this value which may be different from the \IdxPF{max\_integer} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. The domain of an FD variable \texttt{X} is reduced step by step by constraints in a monotonic way: when a value has been removed from the domain of \texttt{X} it will never reappear in the domain of \texttt{X}. An FD variable is fully compatible with both Prolog integers and Prolog variables. Namely, when an FD variable is expected by an FD constraint it is possible to pass a Prolog integer (considered as an FD variable whose domain is a singleton) or a Prolog variable (immediately bound to an initial range \texttt{0..fd\_max\_integer}). This avoids the need for specific type declaration. Although it is not necessary to declare the initial domain of an FD variable (since it will be bound \texttt{0..fd\_max\_integer} when appearing for the fist time in a constraint) it is advantageous to do so and thus reduce as soon as possible the size of its domain: particularly because GNU Prolog, for efficiency reasons, does not check for overflows. For instance, without any preliminary domain definitions for \texttt{X}, \texttt{Y} and \texttt{Z}, the non-linear constraint \texttt{X*Y\#=Z} will fail due to an overflow when computing the upper bound of the domain of \texttt{Z}: \texttt{fd\_max\_integer $\times$ fd\_max\_integer}. This overflow causes a negative result for the upper bound and the constraint then fails. There are two internal representations for an FD variable: \begin{itemize} \item \SPart{interval representation}: only the \emph{min} and the \emph{max} of the variable are maintained. In this representation it is possible to store values included in \texttt{0..fd\_max\_integer}. \item \SPart{sparse representation}: an additional bit-vector is used to store the set of possible values for the variable (i.e. the domain). In this representation it is possible to store values included in \texttt{0..vector\_max}. By default \IdxFKD{vector\_max} is set to 127. This value can be redefined via an environment variable \texttt{VECTORMAX} or via the built-in predicate \IdxFB{fd\_set\_vector\_max/1} \RefSP{fd-set-vector-max/1}. The predicate \IdxFB{fd\_vector\_max/1} returns the current value of \texttt{vector\_max} \RefSP{fd-max-integer/1}. \end{itemize} \index{extra-constrained|see {\texttt{extra\_cstr}}} The initial representation for an FD variable \texttt{X} is always an interval representation and is switched to a sparse representation when a ``hole'' appears in the domain (e.g. due to an inequality constraint). Once a variable uses a sparse representation it will not switch back to an interval representation even if there are no longer holes in its domain. When this switching occurs some values in the domain of \texttt{X} can be lost since \texttt{vector\_max} is less than \texttt{fd\_max\_integer}. We say that ``\texttt{X} is extra-constrained'' since \texttt{X} is constrained by the solver to the domain \texttt{0..vector\_max} (via an imaginary constraint \texttt{X \#={\lt} \Param{vector\_max}}). An \IdxFKD{extra\_cstr} is associated with each FD variable to indicate that values have been lost due to the switch to a sparse representation. This flag is updated on every operations. The domain of an extra-constrained FD variable is output followed by the \texttt{@} symbol. When a constraint fails on a extra-constrained variable a message \texttt{Warning: Vector too small - maybe lost solutions (FD Var:\Param{N})} is displayed (\Param{N} is the address of the involved variable). Example 1 (\texttt{vector\_max} = \texttt{127}): \begin{tabular}{|l|l|c|l|} \hline Constraint on \texttt{X} & Domain of \texttt{X} & \texttt{extra\_cstr} & Lost values \\ \hline\hline \texttt{X \#={\lt} 512} & \texttt{0..512} & \texttt{off} & none \\ \hline \texttt{X \#{\bs}= 10} & \texttt{0..9:11..127} & \texttt{on} & \texttt{128..512} \\ \hline \texttt{X \#={\lt} 100} & \texttt{0..9:11..100} & \texttt{off} & none \\ \hline \end{tabular} In this example, when the constraint \texttt{X \#{\bs}= 10} is posted some values are lost, the \texttt{extra\_cstr} is then switched on. However, posting the constraint \texttt{X \#={\lt} 100} will turn off the flag (no values are lost). Example 2: \begin{tabular}{|l|l|c|l|} \hline Constraint on \texttt{X} & Domain of \texttt{X} & \texttt{extra\_cstr} & Lost values \\ \hline \texttt{X \#={\lt} 512} & \texttt{0..512} & \texttt{off} & none \\ \hline \texttt{X \#{\bs}= 10} & \texttt{0..9:11..127} & \texttt{on} & \texttt{128..512} \\ \hline \texttt{X \#{\gt}= 256} & \texttt{Warning: Vector too small\ldots} & \texttt{on} & \texttt{128..512} \\ \hline \end{tabular} In this example, the constraint \texttt{X \#{\gt}= 256} fails due to the lost of \texttt{128..512} so a message is displayed onto the terminal. The solution would consist in increasing the size of the vector either by setting the environment variable \texttt{VECTORMAX} (e.g. to \texttt{512}) or using \texttt{fd\_set\_vector\_max(512)}. Finally, bit-vectors are not dynamic, i.e. all vectors have the same size (\texttt{0..vector\_max}). So the use of \texttt{fd\_set\_vector\_max/1} is limited to the initial definition of vector sizes and must occur before any constraint. As seen before, the solver tries to display a message when a failure occurs due to a too short \texttt{vector\_max}. Unfortunately, in some cases it cannot detect the lost of values and no message is emitted. So the user should always take care to this parameter to be sure that it is large to encode any vector. \subsection{FD variable parameters} \subsubsection{\IdxFBD{fd\_max\_integer/1}\label{fd-max-integer/1}} \begin{TemplatesOneCol} fd\_max\_integer(?integer) \end{TemplatesOneCol} \Description \texttt{fd\_max\_integer(N)} succeeds if \texttt{N} is the current value of \IdxFK{fd\_max\_integer} \RefSP{Intro-FD}. \begin{PlErrors} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_vector\_max/1}} \begin{TemplatesOneCol} fd\_vector\_max(?integer) \end{TemplatesOneCol} \Description \texttt{fd\_vector\_max(N)} succeeds if \texttt{N} is the current value of \IdxFK{vector\_max} \RefSP{Intro-FD}. \begin{PlErrors} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_set\_vector\_max/1}\label{fd-set-vector-max/1}} \begin{TemplatesOneCol} fd\_set\_vector\_max(+integer) \end{TemplatesOneCol} \Description \texttt{fd\_set\_vector\_max(N)} initializes \IdxFK{vector\_max} based on the value \texttt{N} \RefSP{Intro-FD}. More precisely, on 32 bit machines, \texttt{vector\_max} is set to the smallest value of \texttt{(32*k)-}1 which is $\geq$ \texttt{N}. \begin{PlErrors} \ErrCond{\texttt{N} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \ErrCond{\texttt{N} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, N)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Initial value constraints} \subsubsection{\IdxFBD{fd\_domain/3}, \IdxFBD{fd\_domain\_bool/1}} \begin{TemplatesOneCol} fd\_domain(+fd\_variable\_list\_or\_fd\_variable, +integer, +integer)\\ fd\_domain(?fd\_variable, +integer, +integer)\\ fd\_domain\_bool(+fd\_variable\_list)\\ fd\_domain\_bool(?fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_domain(Vars, Lower, Upper)} constraints each element \texttt{X} of \texttt{Vars} to take a value in \texttt{Lower..Upper}. This predicate is generally used to set the initial domain of variables to an interval. \texttt{Vars} can be also a single FD variable (or a single Prolog variable). \texttt{fd\_domain\_bool(Vars)} is equivalent to \texttt{fd\_domain(Vars, 0, 1)} and is used to declare boolean FD variables. \begin{PlErrors} \ErrCond{\texttt{Vars} is not a variable but is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Vars} is neither a variable nor an FD variable nor an integer nor a list} \ErrTerm{type\_error(list, Vars)} \ErrCond{an element \texttt{E} of the \texttt{Vars} list is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, E)} \ErrCond{\texttt{Lower} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Lower} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Lower)} \ErrCond{\texttt{Upper} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Upper} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Upper)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_domain/2}} \begin{TemplatesOneCol} fd\_domain(+fd\_variable\_list, +integer\_list)\\ fd\_domain(?fd\_variable, +integer\_list) \end{TemplatesOneCol} \Description \texttt{fd\_domain(Vars, Values)} constraints each element \texttt{X} of the list \texttt{Vars} to take a value in the list \texttt{Values}. This predicate is generally used to set the initial domain of variables to a set of values. The domain of each variable of \texttt{Vars} uses a sparse representation. \texttt{Vars} can be also a single FD variable (or a single Prolog variable). \begin{PlErrors} \ErrCond{\texttt{Vars} is not a variable but is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Vars} is neither a variable nor an FD variable nor an integer nor a list} \ErrTerm{type\_error(list, Vars)} \ErrCond{an element \texttt{E} of the \texttt{Vars} list is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, E)} \ErrCond{\texttt{Values} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Values} is neither a partial list nor a list} \ErrTerm{type\_error(list, Values)} \ErrCond{an element \texttt{E} of the \texttt{Values} list is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Type testing} \subsubsection{\IdxFBD{fd\_var/1}, \IdxFBD{non\_fd\_var/1}, \IdxFBD{generic\_var/1}, \IdxFBD{non\_generic\_var/1}} \begin{TemplatesTwoCols} fd\_var(?term)\\ non\_fd\_var(?term)\\ generic\_var(?term)\\ non\_generic\_var(?term) \end{TemplatesTwoCols} \Description \texttt{fd\_var(Term)} succeeds if \texttt{Term} is currently an FD variable. \texttt{non\_fd\_var(Term)} succeeds if \texttt{Term} is currently not an FD variable (opposite of \texttt{fd\_var/1}). \texttt{generic\_var(Term)} succeeds if \texttt{Term} is either a Prolog variable or an FD variable. \texttt{non\_generic\_var(Term)} succeeds if \texttt{Term} is neither a Prolog variable nor an FD variable (opposite of \texttt{generic\_var/1}). \PlErrorsNone \Portability GNU Prolog predicate. \subsection{FD variable information} These predicate allow the user to get some information about FD variables. They are not constraints, they only return the current state of a variable. \subsubsection{\IdxFBD{fd\_min/2}, \IdxFBD{fd\_max/2}, \IdxFBD{fd\_size/2}, \IdxFBD{fd\_dom/2}} \begin{TemplatesOneCol} fd\_min(+fd\_variable, ?integer)\\ fd\_max(+fd\_variable, ?integer)\\ fd\_size(+fd\_variable, ?integer)\\ fd\_dom(+fd\_variable, ?integer\_list) \end{TemplatesOneCol} \Description \texttt{fd\_min(X, N)} succeeds if \texttt{N} is the minimal value of the current domain of \texttt{X}. \texttt{fd\_max(X, N)} succeeds if \texttt{N} is the maximal value of the current domain of \texttt{X}. \texttt{fd\_size(X, N)} succeeds if \texttt{N} is the number of elements of the current domain of \texttt{X}. \texttt{fd\_dom(X, Values)} succeeds if \texttt{Values} is the list of values of the current domain of \texttt{X}. \begin{PlErrors} \ErrCond{\texttt{X} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{X} is neither an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, X)} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \ErrCond{an element \texttt{E} of the \texttt{Vars} list is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, E)} \ErrCond{\texttt{Values} is neither a partial list nor a list} \ErrTerm{type\_error(list, Values)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_has\_extra\_cstr/1}, \IdxFBD{fd\_has\_vector/1}, \IdxFBD{fd\_use\_vector/1}} \begin{TemplatesOneCol} fd\_has\_extra\_cstr(+fd\_variable)\\ fd\_has\_vector(+fd\_variable)\\ fd\_use\_vector(+fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_has\_extra\_cstr(X)} succeeds if the \IdxFK{extra\_cstr} of \texttt{X} is currently on \RefSP{Intro-FD}. \texttt{fd\_has\_vector(X)} succeeds if the current domain of \texttt{X} uses a sparse representation \RefSP{Intro-FD}. \texttt{fd\_use\_vector(X)} enforces a sparse representation for the domain of \texttt{X} \RefSP{Intro-FD}. \begin{PlErrors} \ErrCond{\texttt{X} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{X} is neither an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, X)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Arithmetic constraints} \subsubsection{FD arithmetic expressions} \label{FD-arithmetic-expressions} An FD arithmetic expression is a Prolog term built from integers, variables (Prolog or FD variables), and functors (or operators) that represent arithmetic functions. The following table details the components of an FD arithmetic expression: \begin{tabular}{|l|L{10cm}|} \hline FD Expression & Result \\ \hline\hline Prolog variable & domain \texttt{0..fd\_max\_integer} \\ \hline FD variable \texttt{X} & domain of \texttt{X} \\ \hline integer number \texttt{N} & domain \texttt{N..N} \\ \hline \texttt{+ E} & same as \texttt{E} \\ \hline \texttt{- E} & opposite of \texttt{E} \\ \hline \texttt{E1 + E2} & sum of \texttt{E1} and \texttt{E2} \\ \hline \texttt{E1 - E2} & subtraction of \texttt{E2} from \texttt{E1} \\ \hline \texttt{E1 * E2} & multiplication of \texttt{E1} by \texttt{E2} \\ \hline \texttt{E1 / E2} & integer division of \texttt{E1} by \texttt{E2} (only succeeds if the remainder is 0) \\ \hline \texttt{E1 ** E2} & \texttt{E1} raised to the power of \texttt{E2 }(\texttt{E1} or \texttt{E2} must be an integer) \\ \hline \texttt{min(E1,E2)} & minimum of \texttt{E1} and \texttt{E2} \\ \hline \texttt{max(E1,E2)} & maximum of \texttt{E1} and \texttt{E2} \\ \hline \texttt{dist(E1,E2)} & distance, i.e. $|$\texttt{E1 - E2$|$} \\ \hline \texttt{E1 // E2} & quotient of the integer division of \texttt{E1} by \texttt{E2} \\ \hline \texttt{E1 rem E2} & remainder of the integer division of \texttt{E1} by \texttt{E2} \\ \hline \texttt{quot\_rem(E1,E2,R)} & quotient of the integer division of \texttt{E1} by \texttt{E2} \linebreak (\texttt{R} is the remainder of the integer division of \texttt{E1} by \texttt{E2}) \\ \hline \end{tabular} FD expressions are not restricted to be linear. However non-linear constraints usually yield less constraint propagation than linear constraints. \texttt{+}, \texttt{-}, \texttt{*}, \texttt{/}, \texttt{//}, \texttt{rem} and \texttt{**} are predefined infix operators. \texttt{+} and \texttt{-} are predefined prefix operators \RefSP{op/3:(Term-input/output)}. \begin{PlErrors} \ErrCond{a sub-expression is of the form \texttt{\_ ** E} and \texttt{E} is a variable} \ErrTerm{instantiation\_error} \ErrCond{a sub-expression \texttt{E} is neither a variable nor an integer nor an FD arithmetic functor} \ErrTerm{type\_error(fd\_evaluable, E)} \ErrCond{an expression is too complex} \ErrTerm{resource\_error(too\_big\_fd\_constraint)} \end{PlErrors} \subsubsection{Partial AC: \IdxFBD{(\#=)/2} - constraint equal, \label{Partial-AC:-(:=)/2} \IdxFBD{(\#{\bs}=)/2} - constraint not equal, \\ \IdxFBD{(\#{\lt})/2} - constraint less than, \IdxFBD{(\#={\lt})/2} - constraint less than or equal, \\ \IdxFBD{(\#{\gt})/2} - constraint greater than, \IdxFBD{(\#{\gt}=)/2} - constraint greater than or equal} \begin{TemplatesOneCol} \#=(?fd\_evaluable, ?fd\_evaluable)\\ \#{\bs}=(?fd\_evaluable, ?fd\_evaluable)\\ \#{\lt}(?fd\_evaluable, ?fd\_evaluable)\\ \#={\lt}(?fd\_evaluable, ?fd\_evaluable)\\ \#{\gt}(?fd\_evaluable, ?fd\_evaluable)\\ \#{\gt}=(?fd\_evaluable, ?fd\_evaluable) \end{TemplatesOneCol} \Description \texttt{FdExpr1 \#= FdExpr2} constrains \texttt{FdExpr1} to be equal to \texttt{FdExpr2}. \texttt{FdExpr1 \#{\bs}= FdExpr2} constrains \texttt{FdExpr1} to be different from \texttt{FdExpr2}. \texttt{FdExpr1 \#{\lt} FdExpr2} constrains \texttt{FdExpr1} to be less than \texttt{FdExpr2}. \texttt{FdExpr1 \#={\lt} FdExpr2} constrains \texttt{FdExpr1} to be less than or equal to \texttt{FdExpr2}. \texttt{FdExpr1 \#{\gt} FdExpr2} constrains \texttt{FdExpr1} to be greater than \texttt{FdExpr2}. \texttt{FdExpr1 \#{\gt}= FdExpr2} constrains \texttt{FdExpr1} to be greater than or equal to \texttt{FdExpr2}. \texttt{FdExpr1} and \texttt{FdExpr2} are arithmetic FD expressions \RefSP{FD-arithmetic-expressions}. \texttt{\#=}, \texttt{\#{\bs}=}, \texttt{\#{\lt}}, \texttt{\#={\lt}}, \texttt{\#{\gt}} and \texttt{\#{\gt}=} are predefined infix operators \RefSP{op/3:(Term-input/output)}. These predicates post arithmetic constraints that are managed by the solver using a partial arc-consistency algorithm to reduce the domain of involved variables. In this scheme only the bounds of the domain of variables are updated. This leads to less propagation than full arc-consistency techniques \RefSP{Full-AC:-(:=:)/2} but is generally more efficient for arithmetic. These arithmetic constraints can be reified \RefSP{Boolean-and-reified-constraints}. \Errors Refer to the syntax of arithmetic FD expressions for possible errors \RefSP{FD-arithmetic-expressions}. \Portability GNU Prolog predicates. \subsubsection{Full AC: \IdxFBD{(\#=\#)/2} - constraint equal, \label{Full-AC:-(:=:)/2} \IdxFBD{(\#{\bs}=\#)/2} - constraint not equal, \\ \IdxFBD{(\#{\lt}\#)/2} - constraint less than, \IdxFBD{(\#={\lt}\#)/2} - constraint less than or equal, \\ \IdxFBD{(\#{\gt}\#)/2} - constraint greater than, \IdxFBD{(\#{\gt}=\#)/2} - constraint greater than or equal} \begin{TemplatesOneCol} \#=\#(?fd\_evaluable, ?fd\_evaluable)\\ \#{\bs}=\#(?fd\_evaluable, ?fd\_evaluable)\\ \#{\lt}\#(?fd\_evaluable, ?fd\_evaluable)\\ \#={\lt}\#(?fd\_evaluable, ?fd\_evaluable)\\ \#{\gt}\#(?fd\_evaluable, ?fd\_evaluable)\\ \#{\gt}=\#(?fd\_evaluable, ?fd\_evaluable) \end{TemplatesOneCol} \Description \texttt{FdExpr1 \#=\# FdExpr2} constrains \texttt{FdExpr1} to be equal to \texttt{FdExpr2}. \texttt{FdExpr1 \#{\bs}=\# FdExpr2} constrains \texttt{FdExpr1} to be different from \texttt{FdExpr2}. \texttt{FdExpr1 \#{\lt}\# FdExpr2} constrains \texttt{FdExpr1} to be less than \texttt{FdExpr2}. \texttt{FdExpr1 \#={\lt}\# FdExpr2} constrains \texttt{FdExpr1} to be less than or equal to \texttt{FdExpr2}. \texttt{FdExpr1 \#{\gt}\# FdExpr2} constrains \texttt{FdExpr1} to be greater than \texttt{FdExpr2}. \texttt{FdExpr1 \#{\gt}=\# FdExpr2} constrains \texttt{FdExpr1} to be greater than or equal to \texttt{FdExpr2}. \texttt{FdExpr1} and \texttt{FdExpr2} are arithmetic FD expressions \RefSP{FD-arithmetic-expressions}. \texttt{\#=\#}, \texttt{\#{\bs}=\#}, \texttt{\#{\lt}\#}, \texttt{\#={\lt}\#}, \texttt{\#{\gt}\#} and \texttt{\#{\gt}=\#} are predefined infix operators \RefSP{op/3:(Term-input/output)}. These predicates post arithmetic constraints that are managed by the solver using a full arc-consistency algorithm to reduce the domain of involved variables. In this scheme the full domain of variables is updated. This leads to more propagation than partial arc-consistency techniques \RefSP{FD-arithmetic-expressions} but is generally less efficient for arithmetic. These arithmetic constraints can be reified \RefSP{Boolean-FD-expressions}. \Errors Refer to the syntax of arithmetic FD expressions for possible errors \RefSP{FD-arithmetic-expressions}. \Portability GNU Prolog predicates. \subsubsection{\IdxFBD{fd\_prime/1}, \IdxFBD{fd\_not\_prime/1}} \begin{TemplatesOneCol} fd\_prime(?fd\_variable)\\ fd\_not\_prime(?fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_prime(X)} constraints \texttt{X} to be a prime number between \texttt{0..\IdxFK{vector\_max}}. This constraint enforces a sparse representation for the domain of \texttt{X} \RefSP{Intro-FD}. \texttt{fd\_not\_prime(X)} constraints \texttt{X} to be a non prime number between \texttt{0..vector\_max}. This constraint enforces a sparse representation for the domain of \texttt{X} \RefSP{Intro-FD}. \begin{PlErrors} \ErrCond{\texttt{X} is neither an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, X)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Boolean and reified constraints} \label{Boolean-and-reified-constraints} \subsubsection{Boolean FD expressions} \label{Boolean-FD-expressions} An boolean FD expression is a Prolog term built from integers (0 for false, 1 for true), variables (Prolog or FD variables), partial AC arithmetic constraints \RefSP{Partial-AC:-(:=)/2}, full AC arithmetic constraints \RefSP{Full-AC:-(:=:)/2} and functors (or operators) that represent boolean functions. When a sub-expression of a boolean expression is an arithmetic constraint \Param{c}, it is reified. Namely, as soon as the solver detects that \Param{c} is true (i.e. \emph{entailed}) the sub-expression has the value \texttt{1}. Similarly when the solver detects that \Param{c} is false (i.e. \emph{disentailed}) the sub-expression evaluates as \texttt{0}. While neither the entailment nor the disentailment can be detected the sub-expression is evaluated as a domain \texttt{0..1}. The following table details the components of an FD boolean expression: \begin{tabular}{|l|l|} \hline FD Expression & Result \\ \hline\hline Prolog variable & domain \texttt{0..1} \\ \hline FD variable \texttt{X} & domain of \texttt{X}, \texttt{X} is constrained to be in \texttt{0..1} \\ \hline \texttt{0} (integer) & \texttt{0} (false) \\ \hline \texttt{1} (integer) & \texttt{1} (true) \\ \hline \texttt{\#{\bs} E} & not \texttt{E} \\ \hline \texttt{E1 \#{\lt}={\gt} E2} & \texttt{E1} equivalent to \texttt{E2} \\ \hline \texttt{E1 \#{\bs}{\lt}={\gt} E2} & \texttt{E1} not equivalent to \texttt{E2} (i.e. \texttt{E1} different from \texttt{E2)} \\ \hline \texttt{E1 \#\# E2} & \texttt{E1} exclusive OR \texttt{E2} (i.e. \texttt{E1} not equivalent to \texttt{E2)} \\ \hline \texttt{E1 \#=={\gt} E2} & \texttt{E1} implies \texttt{E2} \\ \hline \texttt{E1 \#{\bs}=={\gt} E2} & \texttt{E1} does not imply \texttt{E2} \\ \hline \texttt{E1 \#/{\bs} E2} & \texttt{E1} AND \texttt{E2} \\ \hline \texttt{E1 \#{\bs}/{\bs} E2} & \texttt{E1} NAND \texttt{E2} \\ \hline \texttt{E1 \#{\bs}/ E2} & \texttt{E1} OR \texttt{E2} \\ \hline \texttt{E1 \#{\bs}{\bs}/ E2} & \texttt{E1} NOR \texttt{E2} \\ \hline \end{tabular} \texttt{\#{\lt}={\gt}}, \texttt{\#{\bs}{\lt}={\gt}}, \texttt{\#\#}, \texttt{\#=={\gt}}, \texttt{\#{\bs}=={\gt}}, \texttt{\#/{\bs}}, \texttt{\#{\bs}/{\bs}}, \texttt{\#{\bs}/} and \texttt{\#{\bs}{\bs}/} are predefined infix operators. \texttt{\#{\bs}} is a predefined prefix operator \RefSP{op/3:(Term-input/output)}. \begin{PlErrors} \ErrCond{a sub-expression \texttt{E} is neither a variable nor an integer (0 or 1) nor an FD boolean functor nor reified constraint} \ErrTerm{type\_error(fd\_bool\_evaluable, E)} \ErrCond{an expression is too complex} \ErrTerm{resource\_error(too\_big\_fd\_constraint)} \ErrCond{a sub-expression is an invalid reified constraint} \ErrTermRm{an arithmetic constraint error \RefSP{FD-arithmetic-expressions}} \end{PlErrors} \subsubsection{\IdxFBD{fd\_reified\_in/4}} \begin{TemplatesOneCol} fd\_reified\_in(?fd\_variable, +integer, +integer, ?fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_reified\_in(X, Lower, Upper, B)} captures the truth value of the constraint $\texttt{X} \in [\texttt{Lower}..\texttt{Upper}]$ in the boolean variable \texttt{B}. \begin{PlErrors} \ErrCond{\texttt{X} is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, X)} \ErrCond{\texttt{B} is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, B)} \ErrCond{\texttt{Lower} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Lower} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Lower)} \ErrCond{\texttt{Upper} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Upper} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Upper)} \end{PlErrors} \subsubsection{\IdxFBD{(\#{\bs})/1} - constraint NOT, \IdxFBD{(\#{\lt}={\gt})/2} - constraint equivalent, \\ \IdxFBD{(\#{\bs}{\lt}={\gt})/2} - constraint different, \IdxFBD{(\#\#)/2} - constraint XOR, \\ \IdxFBD{(\#=={\gt})/2} - constraint imply, \IdxFBD{(\#{\bs}=={\gt})/2} - constraint not imply, \\ \IdxFBD{(\#/{\bs})/2} - constraint AND, \IdxFBD{(\#{\bs}/{\bs})/2} - constraint NAND, \\ \IdxFBD{(\#{\bs}/)/2} - constraint OR, \IdxFBD{(\#{\bs}{\bs}/)/2} - constraint NOR} \begin{TemplatesOneCol} \#{\bs}(?fd\_bool\_evaluable)\\ \#{\lt}={\gt}(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#{\bs}{\lt}={\gt}(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#\#(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#=={\gt}(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#{\bs}=={\gt}(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#/{\bs}(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#{\bs}/{\bs}(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#{\bs}/(?fd\_bool\_evaluable, ?fd\_bool\_evaluable)\\ \#{\bs}{\bs}/(?fd\_bool\_evaluable, ?fd\_bool\_evaluable) \end{TemplatesOneCol} \Description \texttt{\#{\bs}= FdBoolExpr1} constraints \texttt{FdBoolExpr1} to be false. \texttt{FdBoolExpr1 \#{\lt}={\gt} FdBoolExpr2} constrains \texttt{FdBoolExpr1} to be equivalent to \texttt{FdBoolExpr2}. \texttt{FdBoolExpr1 \#{\bs}{\lt}={\gt} FdBoolExpr2} constrains \texttt{FdBoolExpr1} to be equivalent to not \texttt{FdBoolExpr2}. \texttt{FdBoolExpr1 \#\# FdBoolExpr2} constrains \texttt{FdBoolExpr1} XOR \texttt{FdBoolExpr2} to be true \texttt{FdBoolExpr1 \#=={\gt} FdBoolExpr2} constrains \texttt{FdBoolExpr1} to imply \texttt{FdBoolExpr2}. \texttt{FdBoolExpr1 \#{\bs}=={\gt} FdBoolExpr2} constrains \texttt{FdBoolExpr1} to not imply \texttt{FdBoolExpr2}. \texttt{FdBoolExpr1 \#/{\bs} FdBoolExpr2} constrains \texttt{FdBoolExpr1} AND \texttt{FdBoolExpr2} to be true. \texttt{FdBoolExpr1 \#{\bs}/{\bs} FdBoolExpr2} constrains \texttt{FdBoolExpr1} AND \texttt{FdBoolExpr2} to be false. \texttt{FdBoolExpr1 \#{\bs}/ FdBoolExpr2} constrains \texttt{FdBoolExpr1} OR \texttt{FdBoolExpr2} to be true. \texttt{FdBoolExpr1 \#{\bs}{\bs}/ FdBoolExpr2} constrains \texttt{FdBoolExpr1} OR \texttt{FdBoolExpr2} to be false. \texttt{FdBoolExpr1} and \texttt{FdBoolExpr2} are boolean FD expressions \RefSP{Boolean-FD-expressions}. Note that \texttt{\#{\bs}{\lt}={\gt}} (not equivalent) and \texttt{\#\#} (exclusive or) are synonymous. These predicates post boolean constraints that are managed by the FD solver using a partial arc-consistency algorithm to reduce the domain of involved variables. The (dis)entailment of reified constraints is detected using either the bounds (for partial AC arithmetic constraints) or the full domain (for full AC arithmetic constraints). \texttt{\#{\lt}={\gt}}, \texttt{\#{\bs}{\lt}={\gt}}, \texttt{\#\#}, \texttt{\#=={\gt}}, \texttt{\#{\bs}=={\gt}}, \texttt{\#/{\bs}}, \texttt{\#{\bs}/{\bs}}, \texttt{\#{\bs}/} and \texttt{\#{\bs}{\bs}/} are predefined infix operators. \texttt{\#{\bs}} is a predefined prefix operator \RefSP{op/3:(Term-input/output)}. \Errors Refer to the syntax of boolean FD expressions for possible errors \RefSP{Boolean-FD-expressions}. \Portability GNU Prolog predicates. \subsubsection{\IdxFBD{fd\_cardinality/2},\label{fd-cardinality/2} \IdxFBD{fd\_cardinality/3}, \IdxFBD{fd\_at\_least\_one/1}, \IdxFBD{fd\_at\_most\_one/1}, \\ \IdxFBD{fd\_only\_one/1}} \begin{TemplatesOneCol} fd\_cardinality(+fd\_bool\_evaluable\_list, ?fd\_variable)\\ fd\_cardinality(+integer, ?fd\_variable, +integer)\\ fd\_at\_least\_one(+fd\_bool\_evaluable\_list)\\ fd\_at\_most\_one(+fd\_bool\_evaluable\_list)\\ fd\_only\_one(+fd\_bool\_evaluable\_list) \end{TemplatesOneCol} \Description \texttt{fd\_cardinality(List, Count)} unifies \texttt{Count} with the number of constraints that are true in \texttt{List}. This is equivalent to post the constraint \texttt{B$_{1}$ + B$_{2}$ + \ldots + B$_{n}$ \#= Count} where each variable \texttt{Bi} is a new variable defined by the constraint \texttt{B$_{i}$ \#{\lt}={\gt} C$_{i}$} where \texttt{C$_{i}$} is the \texttt{i}\emph{th} constraint of \texttt{List}. Each \texttt{C$_{i}$} must be a boolean FD expression \RefSP{Boolean-FD-expressions}. \texttt{fd\_cardinality(Lower, List, Upper)} is equivalent to \texttt{fd\_cardinality(List, Count), Lower \#={\lt} Count, Count \#={\lt} Upper} \texttt{fd\_at\_least\_one(List)} is equivalent to \texttt{fd\_cardinality(List, Count), Count \#{\gt}= 1}. \texttt{fd\_at\_most\_one(List)} is equivalent to \texttt{fd\_cardinality(List, Count), Count \#={\lt} 1}. \texttt{fd\_only\_one(List)} is equivalent to \texttt{fd\_cardinality(List, 1)}. \begin{PlErrors} \ErrCond{\texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{\texttt{Count} is neither an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, Count)} \ErrCond{\texttt{Lower} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Lower} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Lower)} \ErrCond{\texttt{Upper} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Upper} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Upper)} \ErrCond{an element \texttt{E} of the \texttt{List} list is an invalid boolean expression} \ErrTermRm{an FD boolean constraint \RefSP{Boolean-FD-expressions}} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Symbolic constraints} \subsubsection{\IdxFBD{fd\_all\_different/1}} \begin{TemplatesOneCol} fd\_all\_different(+fd\_variable\_list) \end{TemplatesOneCol} \Description \texttt{fd\_all\_different(List)} constrains all variables in \texttt{List} to take distinct values. This is equivalent to posting an inequality constraint for each pair of variables. This constraint is triggered when a variable becomes ground, removing its value from the domain of the other variables. \begin{PlErrors} \ErrCond{\texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{an element \texttt{E} of the \texttt{List} list is neither a variable nor an integer nor an FD variable} \ErrTerm{type\_error(fd\_variable, E)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_element/3}\label{fd-element/3}} \begin{TemplatesOneCol} fd\_element(?fd\_variable, +integer\_list, ?fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_element(I, List, X)} constraints \texttt{X} to be equal to the \texttt{I}\emph{th} integer (from 1) of \texttt{List}. \begin{PlErrors} \ErrCond{\texttt{I} is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, I)} \ErrCond{\texttt{X} is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, X)} \ErrCond{\texttt{List} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{an element \texttt{E} of the \texttt{List} list is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_element\_var/3}} \begin{TemplatesOneCol} fd\_element\_var(?fd\_variable, +fd\_variable\_list, ?fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_element\_var(I, List, X)} constraints \texttt{X} to be equal to the \texttt{I}\emph{th} variable (from 1) of \texttt{List}. This constraint is similar to \texttt{fd\_element/3} \RefSP{fd-element/3} but \texttt{List} can also contain FD variables (rather than just integers). \begin{PlErrors} \ErrCond{\texttt{I} is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, I)} \ErrCond{\texttt{X} is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, X)} \ErrCond{\texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{an element \texttt{E} of the \texttt{List} list is neither a variable nor an integer nor an FD variable} \ErrTerm{type\_error(fd\_variable, E)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxFBD{fd\_atmost/3}, \IdxFBD{fd\_atleast/3}, \IdxFBD{fd\_exactly/3}} \begin{TemplatesOneCol} fd\_atmost(+integer, +fd\_variable\_list, +integer)\\ fd\_atleast(+integer, +fd\_variable\_list, +integer)\\ fd\_exactly(+integer, +fd\_variable\_list, +integer) \end{TemplatesOneCol} \Description \texttt{fd\_atmost(N, List, V)} posts the constraint that at most \texttt{N} variables of \texttt{List} are equal to the value \texttt{V}. \texttt{fd\_atleast(N, List, V)} posts the constraint that at least \texttt{N} variables of \texttt{List} are equal to the value \texttt{V}. \texttt{fd\_exactly(N, List, V)} posts the constraint that at exactly \texttt{N} variables of \texttt{List} are equal to the value \texttt{V}. These constraints are special cases of \IdxFB{fd\_cardinality/2} \RefSP{fd-cardinality/2} but their implementation is more efficient. \begin{PlErrors} \ErrCond{\texttt{N} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \ErrCond{\texttt{V} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{V} is neither a variable nor an integer} \ErrTerm{type\_error(integer, V)} \ErrCond{\texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{an element \texttt{E} of the \texttt{List} list is neither a variable nor an FD variable nor an integer} \ErrTerm{type\_error(fd\_variable, E)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxFBD{fd\_relation/2}, \IdxFBD{fd\_relationc/2}} \begin{TemplatesOneCol} fd\_relation(+integer\_list\_list, ?fd\_variable\_list)\\ fd\_relationc(+integer\_list\_list, ?fd\_variable\_list) \end{TemplatesOneCol} \Description \texttt{fd\_relation(Relation, Vars)} constraints the tuple of variables \texttt{Vars} to be equal to one tuple of the list \texttt{Relation}. A tuple is represented by a list. Example: definition of the boolean AND relation so that X AND Y $\Leftrightarrow$ Z: \begin{Indentation} \begin{verbatim} and(X,Y,Z):- fd_relation([[0,0,0],[0,1,0],[1,0,0],[1,1,1]], [X,Y,Z]). \end{verbatim} \end{Indentation} \texttt{fd\_relationc(Columns, Vars)} is similar to \texttt{fd\_relation/2} except that the relation is not given as the list of tuples but as the list of the columns of the relation. A column is represented by a list. Example: \begin{Indentation} \begin{verbatim} and(X,Y,Z):- fd_relationc([[0,0,1,1],[0,1,0,1],[0,0,0,1]], [X,Y,Z]). \end{verbatim} \end{Indentation} \begin{PlErrors} \ErrCond{\texttt{Relation} is a partial list or a list with a sub-term \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Relation} is neither a partial list nor a list} \ErrTerm{type\_error(list, Relation)} \ErrCond{an element \texttt{E} of the \texttt{Relation} list is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{\texttt{Vars} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Vars} is neither a partial list nor a list} \ErrTerm{type\_error(list, Vars)} \ErrCond{an element \texttt{E} of the \texttt{Vars} list is neither a variable nor an integer nor an FD variable} \ErrTerm{type\_error(fd\_variable, E)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Labeling constraints} \subsubsection{\IdxFBD{fd\_labeling/2},\label{fd-labeling/2} \IdxFBD{fd\_labeling/1}, \IdxFBD{fd\_labelingff/1}} \begin{TemplatesOneCol} fd\_labeling(+fd\_variable\_list, +fd\_labeling\_option\_list)\\ fd\_labeling(+fd\_variable, +fd\_labeling\_option\_list)\\ fd\_labeling(+fd\_variable\_list)\\ fd\_labeling(+fd\_variable)\\ fd\_labelingff(+fd\_variable\_list)\\ fd\_labelingff(+fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_labeling(Vars, Options)} assigns a value to each variable \texttt{X} of the list \texttt{Vars} according to the list of labeling options given by \texttt{Options}. \texttt{Vars} can be also a single FD variable. This predicate is re-executable on backtracking. \SPart{FD labeling options}: \texttt{Options} is a list of labeling options. If this list contains contradictory options, the rightmost option is the one which applies. Possible options are: \begin{itemize} \item \AddFOD{variable\_method}\texttt{variable\_method(V)}: specifies the heuristics to select the variable to enumerate: \begin{itemize} \item \IdxFOD{standard}: no heuristics, the leftmost variable is selected. \item \IdxFOD{first\_fail} (or \texttt{ff}): selects the variable with the smallest number of elements in its domain. If several variables have the same number of elements the leftmost variable is selected. \item \IdxFOD{most\_constrained}: like \texttt{first\_fail} but when several variables have the same number of elements selects the variable that appears in most constraints. \item \IdxFOD{smallest}: selects the variable that has the smallest value in its domain. If there is more than one such variable selects the variable that appears in most constraints. \item \IdxFOD{largest}: selects the variable that has the greatest value in its domain. If there is more than one such variable selects the variable that appears in most constraints. \item \IdxFOD{max\_regret}: selects the variable that has the greatest difference between the smallest value and the next value of its domain. If there is more than one such variable selects the variable that appears in most constraints. \item \IdxFOD{random}: selects randomly a variable. Each variable is chosen only once. \end{itemize} \BL The default value is \texttt{standard}. \item \AddFOD{reorder}\texttt{reorder(true/false)}: specifies if the variable heuristics should dynamically reorder the list of variable (\texttt{true}) or not (\texttt{false}). Dynamic reordering is generally more efficient but in some cases a static ordering is faster. The default value is \texttt{true}. \item \AddFOD{value\_method}\texttt{value\_method(V)}: specifies the heuristics to select the value to assign to the chosen variable: \begin{itemize} \item \IdxFOD{min}: enumerates the values from the smallest to the greatest (default). \item \IdxFOD{max}: enumerates the values from the greatest to the smallest. \item \IdxFOD{middle}: enumerates the values from the middle to the bounds. \item \IdxFOD{bounds}: enumerates the values from the bounds to the middle. \item \IdxFOD{random}: enumerates the values randomly. Each value is tried only once. \item \IdxFOD{bisect}: recursively creates a choice between \texttt{X \#={\lt} M} and \texttt{X \#{\gt} M}, where \texttt{M} is the midpoint of the domain of the variable. Values are thus tried from the smallest to the greatest. This is also known as \textit{domain splitting}. \end{itemize} \BL The default value is \texttt{min}. \item \AddFOD{backtracks}\texttt{backtracks(B)}: unifies \texttt{B} with the number of backtracks during the enumeration. \end{itemize} \texttt{fd\_labeling(Vars)} is equivalent to \texttt{fd\_labeling(Vars, [])}. \texttt{fd\_labelingff(Vars)} is equivalent to \texttt{fd\_labeling(Vars, [variable\_method(ff)])}. \begin{PlErrors} \ErrCond{\texttt{Vars} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Vars} is neither a partial list nor a list} \ErrTerm{type\_error(list, Vars)} \ErrCond{an element \texttt{E} of the \texttt{Vars} list is neither a variable nor an integer nor an FD variable} \ErrTerm{type\_error(fd\_variable, E)} \ErrCond{\texttt{Options} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is neither a partial list nor a list} \ErrTerm{type\_error(list, Options)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is neither a variable nor a labeling option} \ErrTerm{domain\_error(fd\_labeling\_option, E)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Optimization constraints} \subsubsection{\IdxFBD{fd\_minimize/2}, \IdxFBD{fd\_maximize/2}} \begin{TemplatesOneCol} fd\_minimize(+callable\_term, ?fd\_variable)\\ fd\_maximize(+callable\_term, ?fd\_variable) \end{TemplatesOneCol} \Description \texttt{fd\_minimize(Goal, X)} repeatedly calls \texttt{Goal} to find a value that minimizes the variable \texttt{X}. \texttt{Goal} is a Prolog goal that should instantiate \texttt{X}, a common case being the use of \IdxFB{fd\_labeling/2} \RefSP{fd-labeling/2}. This predicate uses a branch-and-bound algorithm with restart: each time \texttt{call(Goal)} succeeds the computation restarts with a new constraint \texttt{X \#{\lt} V} where \texttt{V} is the value of \texttt{X} at the end of the last call of \texttt{Goal}. When a failure occurs (either because there are no remaining choice-points for \texttt{Goal} or because the added constraint is inconsistent with the rest of the store) the last solution is recomputed since it is optimal. \texttt{fd\_maximize(Goal, X)} is similar to \texttt{fd\_minimize/2} but \texttt{X} is maximized\texttt{.} \begin{PlErrors} \ErrCond{\texttt{Goal} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Goal} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Goal} does not correspond to an existing procedure and the value of the \texttt{unknown} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{existence\_error(procedure, Pred)} \ErrCond{\texttt{X} is neither a variable nor an FD variable nor an integer } \ErrTerm{type\_error(fd\_variable, X)} \end{PlErrors} \Portability GNU Prolog predicates. %HEVEA\cutend gprolog-1.4.5/doc/compil-scheme.png0000644000175000017500000003273513021324543015331 0ustar spaspa‰PNG  IHDRŠó”Z’’ )iCCPiccxÚ•‘gP”‡†Ï÷}Û m—¥ÃÒ›T) HYz•^E–ÞY–"bCÄDiŠ ¢€‚Q)+¢X ŠXÐ,”Œ"*(÷GîLœ{'?òüzæwÎ93€"€Š¤¤ ø~.öìÐ06|G$/3ëãã ÿÈÇQ@¬‚%:&“ËÏKç \Ðʤ £ÀŒJJ ç€É @n3î/fÔ_>L~€ŸŠ Ñâ¾ó¨ïü¿{T¸|ABlL.Û?-VÉagú¹Ø³ÝØ>ü´Ø„ä˜ïþWå@“+pHKßÄOˆ‹°ÿo¨±¡‘üý‹÷¾€ÂüßÿÀw½´Fζïï,ª {€ôÓ¿3µ£¢…]÷xYüì¿2( LEP-Ðc0+°'po€PØ<ˆ‡àCäÃ(‚Ø¡ê¡ Z ÎB7\„kpîÂ}…g „)xóð–!"t„È Jˆ:¢‹#ÄqB<?$‰@âT$ ÉGv"%H9Rƒ4 -ÈOÈärFž È,ò'òÅPÊDP Ôå \Ô @×£qhš‡¢{Ñ*´=…v¡×лè(*Dß  `TŒ…)czsÀ¼±0,ãc[±b¬kÄÚ±^l{€ ±9ì3Ž€càØ8=œÎˆãá2p[q¥¸ÜI\®÷7›Ç}ÃÓñòx]¼%Þ ‚Ãçà‹ð•øf|'þ~?…ÿH XM‚9Á•JH$l&”:W ÄI‘H”!ê­‰ÞÄH¢€XD¬&ž"^!Ž§ˆŸHT’ɘäL #¥’ H•¤VÒeÒiš´D#«“-ÉÞähò&r¹‰ÜK¾Gž"/QÄ)škJ%‘²ƒREi§Ü ŒSÞS©TªÕ—š@ÝN­¢ž¡Þ¢NP?Ó$h:4Z8-‹¶—v‚v•ö„öžN§kÐíèat}/½…~þ‚þI„!¢/â&-²M¤V¤KdDä­(YT]”+ºA4O´Rôœè=Ñ91²˜†˜ƒX¤ØV±Z± bcb â q#qoññRñVñÛâ3D '‰h‰B‰c×%&C•áÀà1v2š7SLS“éÆLd–0O3‡˜ó’’&’A’¹’µ’—$…,Œ¥Árc%³ÊXgYX_¤¤¸R1R{¤Ú¥F¤¥å¤í¤c¤‹¥;¤G¥¿È°eœd’döËtË<—ÅÉêÈúÊæÈ‘½!;'Ç”³’ãÉË•{*ÊëÈûÉo–?&?(¿  ¨à¢®P­p]aN‘¥h§˜¨X¡xYqV‰¡d£” T¡tEé5[’Íe'³«ØýìyeyeWå,åå!å%M•@•••çªUŽj¬j…jŸê¼š’š—Z¾Z›ÚSu²:G=^ýú€ú¢†¦F°ÆnnMiM7Í<Í6Íq-º–­V†V£ÖCm‚6G;Iû°ö}TÇT'^§Vçž.ªk¦› {Xwx~•ÅªÔU«Æôhz\½l½6½ }–¾§~~·þ[5ƒ0ƒýß M “ › ŸI¹õýi¬cÌ3®5~¸š¾Úyõ¶Õ=«ß™èšÄ˜1ylÊ0õ2ÝmÚgúÕÌÜŒoÖn6k®fa^g>Æar|8¥œ[x {‹m->[šY ,ÏZþa¥g•dÕj5³FsMÌš¦5“Ö*Ö‘Ö ÖB¶M„ÍQ¡­²m¤m£íK;U»h»f»i®67‘{ŠûÖÞОoßi¿è`é°Åáª#æèâXì8ä$áèTãôÂYÅ9ιÍyÞÅÔe³ËUW¼«‡ë~×177ž[‹Û¼»¹û÷~š‡¿GÇKOO¾g¯êåîuÀk|­úÚÔµÝÞàíæ}Àû¹¦O†ÏϾ_ßZßW~F~ù~þ ÿþ­þìÊžjfö‰…µ-;— C B¶„Ü • Mí #†…5‡-¬sZwpÝT¸ixQø£õšës×ßÞ »!yÃ¥¢#7ž‹ÀGG´F,GzG6F.D¹EÕEÍóx‡xo¢í¢+¢gc¬cÊc¦c­cËcgâ¬ãÄÍÆÛÆWÆÏ%8$Ô$¼KtM¬O\LòN:‘´’œÜ‘BJ‰H¹*‘š”ÚŸ¦˜–›6œ®›^”.Ì°Ì8˜1Ï÷à7g"™ë3{LAº`0K+kWÖD¶Mvmö§œ œs¹â¹©¹ƒ›t6íÙ4çœw|3n3os_¾rþŽü‰-Ü- [‘­Q[û¶©n+Ü6µÝeûÉ”I;~)0,(/ø°3xgo¡BáöÂÉ].»ÚŠDŠøEc»­v×ÿ€û!ᇡ=«÷TïùV]|§Ä°¤²d¹”WzçG£«~\Ù»w¨Ì¬ìÈ>¾Ô}öÛî?Y.^žW>yÀë@W»¢¸âÃÁoWšTÖ¢Ê:$¬ò¬ê©V«ÞW½\_3Zk_ÛQ'_·§nñpôá‘#vGÚëêKê¿M8ú¸Á¥¡«Q£±òáXö±WMAMÇ9Ç[še›Kš¿žH=!<éw²¿Å¼¥¥U¾µ¬ mËj›=~êþiÇÓ=ízí ¬Ž’3p&ëÌëŸ"~ztÖãlß9ιöóêçë:Å]Hצ®ùîønaOhÏð÷ }½V½?ëÿ|â¢òÅÚK’—Ê.S.^^¹’weájúÕ¹kq×&û6ö=»rýa¿oÿÐ ·n:ß¼>À¸rËúÖÅÛ–·/ÜáÜé¾kv·kÐt°óÓ_:‡Ì†ºî™ßë¹oq¿wxÍðåÛ‘kÜ|èöðîèÚÑáG… G?žy’üäÝÓì§K϶ãÇ‹Ÿ‹=¯|!ÿ¢ñWí_;„fÂKŽƒ/ý_>›äM¾ù-ó·å©ÂWôW•ÓJÓ-3Æ3ggï¿^÷zêMú›¥¹¢ßů{«õöüv ·ÌO½ã¿[ù³ô½ÌûL>ô-ø,¼ø˜òqi±ø“̧“Ÿ9Ÿ¾™^ÊY&.W}ÕþÚûÍãÛøJÊÊÊ.¢¼P§î±bKGDÿ‡Ì¿ pHYsHHFÉk>+—IDATxÚí]¨,Ùuß+ Žlì=Í ’±³o°!xìºO$Ô!½Õaü‚pR'&OÁÝJ^F¡?ØÄŽD7 aŠC7(`ÂÐõ`a0ar˲ÈCäˆ[ÌeìÄòhnÉÑD Ñ5+UýUç³ûtu}œõkÎéîêª]«v÷¿ö×Ú{‰Ò$<ÁI2-Ú¾N£]þZÛìEÔø‚¶/Òh›WšHTPhvÍç‘.J¸Ð´Ùìf“7zA3%EÎ’/K‰/(ó¶/Û0®§Qhdº`vU…çºòÃ0ºA#Õ§5ŽBbBàÏøsr"&+Iˆ#^m‘™ŽÛÎÃhRx.ðúDF二%«ÏãÕ9'Ô3ñX¯Ñ šë}Êt¦ZhŽ_¾ÙRàÄ 7¢ ãnœªK6«º:óË[4'%dfm £4Ó%¡”Ã`^&L%ÂsÀöñ„²8°£Ö0ŽŠ´?¢-9žð¶†¶$M7Å%„¦ÇBŒ®ÓlïÓÝ)HqXõÉè…^Hdšß;)Ã8…UXŒnÑ/‡À£"eG°aÔèDIqZÄá<³°acÅIE!èBBMïá){? B"¨‰H@(# RU7N* I˜0’o“JÀüÔ~ÚâQ0¾<‰H32GDÌoÖ*£{œpœB–z¶}bÝ[÷§ÇÄz¸ŒÛ9YI!1¡$Ìp̵r GŒ#à‚p:ièÜ!#&ÖÇeÜS–UÙP>‹ªHBNNÂWù@ÇÜÖØ=¤¤ÇÌ)ݸ;ívÉ,4Õ'ü*,ï°ÿ'Äßa¯-$bÎÂ$aìC»¢È)§«¾¡g,HnÝÿ7ÉTî¸|x™ãõÌ:[ý8YõIžr® xʨþ/ÉÈù.ø»´)Ä’3»©Ñ,ŽŽç¼m’0ö¥^²™í‰ñd¤—ôÕgÍ$!µæµ±/=ÑÖœ1H@$1¯=lCÅÍ¥ˆaÜLOEQRºx 2“ƒqz-Šš‘a³öŒ#ñ€½d ãjL†QcØ¢°ž'ã†- Ã8…aÔ0QFžŽhßáÂ<_áàcj3±½lI¡9ßáx·mKŒ¾1XQï˜(Œ}²(ÞàËm›aôÁ¶)@<_ã%Þ¢û1`Q€<ç#ýTÛV}c×òM>jÛ£t¦¤i ‘}šïóNƒFç:k0u£%ºSRÇ_^@\©µ!äöYåFéŽ(ÀšØÆ! ¹KÖ0ÂDa5L†QÃDa5L†QÃDa5L†QÃDa5L†QcP¢D–× ‰ä©¼0W c_†åæ±  ,_ŠgÎ9SÉÚˆÃjô—ž‹B–@Ž§`¢™fâV¢ à\ ^æ8fºX?Oñ@ÆŒ)ŽŒ€Ìâ%}¯>¥„LÈ©…ÓB S`FŽ™“9&Dxr %fƨíK1ºBÏK ²*Èc*£2hýqÌqœi!3F„D¤š‹#\‡+(ÈÈtqâ ÞF‡é{IH"¡$ìÄ4’€%g„iNNÌ‚˜  ±HÆ•ô½¤pLÉ8ÃËSQR=#" &,HqŒ‰H±(PTU®œPb¹ž·})FèÎtÔbdƒ„,õ€šO½ªuJ›®Ó÷êS²”`ßÃ,<¤q=}¯>]àÀÂǤç¢09ǧïÕ'Ã8:& èa¢0Œ& èa¢0Œ& èa¢0Œ& èÑÁ;'áý©ñˆù°í 3úFwJŠ&¦ŒþÍÆ1²èƒ¤3%E.zòUsý3ö¥;%…at…aÔ0QF …aÔ¶(liãL†QcØ¢0Œ0QFÎ,qsô ó|ž×€çúÙ¶m1úÅ`EòŸr}ܶ%F¿rõé[¼ß¶Fß²(¾À;m›aô!‹âMà{¼Õ¶Fßp›ä}T?Þ¶FßèŒëx#|›—m›`ô^‰bï¹yðrïc2-Ú¾N£]úÕ¦ˆöÜÿ-¾´ç{¯`n †J )Cgy ÓBÂÕÜ:q«;±¸Í}y÷Ý5{ΣÛ{Öù2š+) –š3"Ôpë;p"qõ*gºŠ='ž§Õž†Ñ2 ‰B3RB`VUyˆÃ­*AZ‹ ÂÕ7:BsmŠà`'ÎPÄ^6±®gÄ•T¬”0:B“¢ÅãYK´^ÀÆk±.=ʽbqD¶XŒÑ…,‘3#"(#Iˆ“·®4¡)1^m:Ñš§X0çU-dóƒõ@1«¸¢3¦œµ †±¡AQèB&Z³²-¾ê-ˆ%ÅJ  5“O±é®5Œöè•ïSóq«7ã)ÆÃ¥_#Ú†qL†QÃDa5°(ĉkÛ£‹ôÊuü8ˆ'Âx g¡æfbTœT.$Ô$Ò&´ÜfAHÌv% ¡Œ(HÍÙÄ8©($aÂH¾AL*óSûi‹gDÁøòXˆfd Žˆ˜ß:­UF÷8á8…,ukäZT÷Å}Æ)$Á11wãvNVRHL( 3óÕòdâˆq\®t/oàÜ!#&6(gÜS–UÙP>‹ªHBNNÂWù@ÇÜÖØ=¤¤Çš 7†D»]² Mõ ¿J Ë;ìÿ‰•wí]‘ˆ9 “„±íŠ"§œšú†ž±XMM½ßd$S¹ãòâeŽ×3ël5öãdÕ' xʹ.$à)O ú¿$#ç»ü!àïÒ¦GDHÎì¦F³8F8žó¶IÂØ—^yÉn™í‰ñd¤—ôÕgÍ$!µæµ±/=ÑÖœ1H@$1¯—=q7—"†q3=EI9èà (ÈLÆýéµ(VhFF N#Æ0yÀ^²†q5& è1lQXÏ“qÃ…a€‰Â0j˜( £FOG´ïpaž¯ð ð1µ™ØÆ^ ¶¤ÐœïðˆG¼Û¶%F߬(X…•·m3Œ¾1dQ¼ À—Û6ÃèƒmS€x¾ÆK¼-ÚlìÇ€EòœôSm[aôA8^Ë7ù¨mŒþÑ™’B¦ ,Dös|ŸÿޠѹZX²Ò’¢8þòâ É…Ü>«Üè!ÝEXÛ8„!wÉÆA˜( £†‰Â0j˜( £†‰Â0j˜( £†‰Â0j˜( £†‰Â0j<QH$Oå…9ewcÐn%â™sNÁT²6"²}£Ç¢9Ž™.ÖÏS<1cJ## Ó1çº)x"ñÎ'¬Ž±XGƆ>WŸrÈœ”€ È™0!“)13F ….@¦@²ûÉæ Û¾£;ô¸¤`ƈˆ‚Tsq„ëa™.ʨÄâ˜ã8ÓBv>Ù9Æ0*z\RhNNÌ‚˜  ¹ŸB–œ^Š–wí1ƃF;ò 9à˜)säö/ÌèÝ))š˜(ú 4ÇÈ¢S ’ΔM8æIÈWÍáÏؗÑL†QÃDa5L†QcØ¢° Œ0QFa‹Â0ÀDa5:³ÄÍÑ/Ìóy^žëgÛ¶ÅèƒÈ{|ÈõqÛ–ýbÈÕ§oð~Ûf}cÈ¢ø:ï´m†Ñ7†,Š7ïñVÛf}cÀm ÷QýxÛV}£3®ãðm^¶m‚Ñ?z%Š½çæ}À˽ɴhû:O‰¸ÆORhÖöuîímŠË?ªûN•­‰§—¨ÜÌ~{Ã[|iÏ#‚û]]ïØ7O»zŽ#rKI!Ž˜ôæ-{–)HÀÙãÈbÏytûG«¸×…õ“æç&Þý6º³gQ–aǵï.ñHn))´ÐóÛ¶ìͺ(íW¡jœ€ŒeUVÈË×’ÈRü¾ ‰»fk|û~5QH$s‰e.±ÄòT" äH,KIä©„Pn©öö’H$ ˆ—Xb­žAœŒ$‘e=E¼Lå™TæÉHž‰'Ki¾vkt-€LSM¹X¿3cÏ߆8¦W§¿{K¿f¿KqÜž*„,B¦ ªòT!*c¼¡ë}C¢j‰B°zVHˆ yZ»bù:àÅ*-žáñÄ·Å"k>Æ!aÛ×Nû8Eܾ}ή¾‡òuõ ‰ªWŽS~‚s…˜% O ñÄÄŒñŒ˜˜9sm÷½ø­[ŸH,KYjŠ¯j3Yn=CÀBS}¢éÕ)j¶Õë1!&ld‘£D’Ô+9äë™.Hùer]0fä83!$Â댔Œ\gäx=×1žLŒ@3üÎþå~5ÑÖ™žé™ŒÖÍ @ÏX¬Ÿ!//L®ïÍÙLZáVW¨q- ëym‚˜_wšä  ~@óê6»ºionʬ·³uóÞÞ~íï­Þ¦ñâ ªÿN>àñâ ñâ$Øù¡G“ID(éúfŒd)S~¬–¢§ÀI(#ÎWiiÁâž=ZÆÀÐ-QHL¾î3ʉ@Z•»âÙÜ”·ØºyßñäxÜ­ÖimŠ¶rþTç BIpŠB€2%!YmQ<ÏX’à˜1"Tˆy†'aÎo1ÂóŒ˜ÏF<%æ)J°µÿëWµ):àû$ ŽTïТh>nµ„-ˆð)b÷-ÞxÜW¹q5„„²$Õ ëü=âdJ çÇê”X¢Ò‘£œzJ"¾>¡šÄH\}æd$‘Ì%ØîP¦K(‰|fkâÃæ ë '¼'éö3ª°¬ôK–MÜÕpõÂØ÷ÍS…˜yå.#¢²¤ØL=ØýålOc¨Þ/ן•G{žÕ§;ìþ7“ÖÊG»]²•'-o\åÆuŸØ·ÃO"æ,úådpb~@öœ•.^æ ç”»áº«c3õ Îõ®!\á9{›3Ô|kO& ÊÖé[ùÇ®Í÷y§A£óƦeÞ ‹^ý:?Âï7”v'VjìNIQyqU¼Í†Û—Zh×Ü+ñÍ´($¤cJÝEX»†ÜȆawÉÆA˜( £†‰Â0j˜( £†‰Â0j˜( £†‰Â0j TÉSyÑéÁ5£³ rðNi^›UH¸ž?0f»uëqšÿn÷xãF BqZPÆ-œ’sN(肼 ¡¥…ÃX½w(Õ'nŠ®³û‰ÃŽÃs,Ä‹²•˜òÆñB”€ß& âsÐ ^ˆŠ¶móqèmIa4ͺ,.ßœ‰¿z‚‘ŽeB@6”I]& ãÎ\?ãNïð¹7 ¨údÇÁDa5L†QÃDa5L†QÃDa5L†QÃDa5L†QÃDa5ºãæáäøîdøÛ¾°Öš<õƒÐP®t`!þ.ŧhÂÃò—ø#¾Ú Ñyw×ß×Ø”ŸŸÆrµN…E#—4£áá"áMnúCÀÚ†QÃDa5L†QÃDa5†-ŠÎö ]ÆDa5†- Ã8…aÔìàx>ÏkÀsýlÛ¶ q|¡ÌUþyÆžºÊ¡Šä=> äú¸mK†„<ê?Ö¶%Í1äêÓ·x¿m3F™ŸßjÛŒ&²(¾À;m›10ÊüüzÛf4ÉEñ&ð=ÞjÛŒñߣÌÛÁ2à6Èû¨~¼m+††ü¯è«m[Ñ$Ý™dÔßæeÛ& þ«é×åí=é^î}L'¦¹œ p{ò¿yuÏ\-´3êîJ m Ùšxºg Á}þŗö<"Lˆª»²(ÇÏlü­ÒFI– ·KÀœ}&ïneïùa1$dó³èö+Wª‰´n3ÙW"ªo_¢æ#£·Ñû´.JûU¨§@b r¦ëm )?ǯT·ÑƹWI!ž˜Œ@Çâ Ç¢|Ö‰8b3"Òªlˆ™èð2%d¢e¬º1gÌ9Xõy£Ž„$<Ö¸M ç@ ~@³S”å÷+)<™.^g¤ëgQâ(ð:cF¤3ÆUT´\/8_E·Ö ®ŒÖl"÷…ŒÖÍ´@ÏX¬Ÿ!'ë{s6S€D8+' ²­Ÿþõln¸››ð¹oïS$™Dâ(H «g˜±”œÿŠOPýwâ)pp.H ™²R Aã`<_ö:IpmGLN̤cÑ3‰I8;ªmG·/$ÇÛë^v„„mçEsþtç bɈˆ„ Ú D(Áúÿ –Lq$DDŒŽkoF´%ÁY9a”è‚…xØŒFhV mÿ_ù^›°¡¢`†³ cCÛ+ôv@mgaì2äù†qXâd_ÿPãVä.]ªç¤Õ'‰@žÊ±ë+<(@ÊáÄœ…µjîƒ8"y•§9‘ösìé„¢„ #ù1éÞþ±Ç²!$f»€PÊQÒ^~‰í"žGª;[‰@Ö?O…S–ŒóS9ví"žãËw/ÍȪ¯1æ·NnXÇÇärg‰”îžÉþé¶ËÉDQºu1Ã1_­Ä´ö¤½XùÖ6xþäê/oƒÌÊ/Ò¸1»y>†.¬¤¸É´ô{”mÇ®œŒÏñŽ¥±9o2b2ìT§F …ž·mG´;N0Ñ‚'â˜Ë²™ÑIqŒ@ëóà‘˜ñPG˜Úí’­IÀSÎu!OyÕÿ%9ßå[›Bb ½[g®x²&Û)C@1é]§xI‚»ª³bHôn14qD„äÌnºSU½"ÏyÛÆî‚D„Üz»‘˜ˆ ÅÐg×÷N•ÙžOFzùë©>›hfq´÷¡€+È.KC =„8Ú=Ee|@„òõ !!ŽbUŠ˜(ögkl:«†2ŠM)2|QtÀKöpÊA7_Þãn®T·³tó”+´d¯]ÖkQ¬Ð¬ÎÝFsò‡:õë{ÉÆÕ˜( £Æ°Eñ@‹ã~ [†q& èa¢0Œ½¼»ñÂ<_áàcj3±†8þ„¿৆ëÿ4Ø’Bs¾Ã#ñnÛ– -ø3ñˆb¸’°(X…A·m3Æ»jÛ„ò?Ô¶ ÍÒ™’B¦ ,Döi¾Ï; kg—Ä‘ ±èÕ¯ó#ü~Ciwb¥Æî”Åñ—M¶(¤ËË|¹æ&X­b =ÝNŒ)uG `Mìfr#†Ý%ka¢0Œ& èa¢0Œ& èa¢0Œ& èa¢0Œ& è1èí]d¹¼E²‡»Bb<)Å1¼$UNö?_(Hkaa„mÕâX9SüQ¢Ô.v^÷<_{% ™â¡¼ ID ¤:Û}W½Î˜à˜RàÈÈHAædL4ÍÄ­¾¼Í1Zˆg ̈)¸¨ÿTL¡g ž§µ<ùV.ç|‘_ß䤎¥””§¨Bd«•ßûŸ¯ýjSäL˜IÌɘPT~•ëw1eÆ„€Dsr %fƨJá‚œùn²ÛÇ€æLI˜Ñ7æ†ÊkÓ\_ÝÉ Ï’” 9HÈ”¿^ËÉ”‚ 9K`AÊAÂz›¯Ú‘É­{8–ÕËP!áÊœ Ý£O%ÅTxL^EOxÌ«åÖw0cÂäªh«‚„µ{ÕÇt¹x?‘x'Óí9¾š…9‘8 æ gqI$”äR^ŸùÚ¶*ï~×%àŠòå3ÕÆD ÁæÝVy²Ä£(qõ·:öñÖ1Êrûe½¯âïks‹ùyË]—¤z‘\³}¹õîY•ß«œœ¢LyÆœ`;'ï—¯]))Z7`¿Øv¦•EüUïð×gîuŸÜtÌýln)?ïð»zᦒƒ++¨—R×;Ú±G¾š(ê†tøÖG››ýñey•\ºkóݽê’5:Ãn¸ƒMÆ U%}ê}2Œ“`¢0Œ& èa¢0Œ& èa¢0Œ& èa¢0ŒÝ¼srüÙZøÛ¾°ÖŽ1¥î >Å7š²¸3-º#ŠÅý“¸Ä/ðG|µA›;øyý ?ËßàCþOc¢Èº!ŠÎmiäâ’æb4<$$ÄáÈH‡íÞ±¢;%…Ñ)Äà€ŒÙÐ#Rìb¢0vxÈbXa¢0OHåÚmÛÓ&&ŠÎŽÆ[ +†-ŠYøß  (V+gL ñ8rR´mM7¶(Œ5â)ÈJÇêá˜(ÎÖ(C'·÷ÁÞ‰çó¼<×϶mK W¿Ý±š>ÌŽÕì(@Þã“@®Û¶ä„×lb8C®>}‹Oï·mÆ)°Q†c2dQ|×wÚ6£Il”¡ †\} Yò=>=ÄæåÎ(ƒ¹<™‹ä}T?Þ¶G½¢íQCC ¹úßæeÛ&e8%ÃÅÿ⣶M¸6ÊÐî>ý\õÔ:VÛeТè&†n0@QH€#Àá(pø*6*¤ÐÍÆéNÇjj«m3Qˆ'ÂáÉŒ‚l÷Ç%!R®á˜u¡Zebè&ƒ…D„p÷º8bBRfíüm”¡Ûô\â‰ñ‡M“‘Hµ‰Åu®>£2ô‚“ˆBÁêG Ñq~„âøGüùý&׋#"¼o*·žÅFzÅiÆ)ÊÊJIxݲgâöªÌü=þ!OïÛG£…¤xþ_äÿ²m”¡Ÿœ¦¤éÙ-û8¦z¾WšUr[& ‰ €™f’èø®¹ëXí5•âˆÉ‰˜hx™2!cªOÄãô¬Ú+dLL ñ~m-˜0‘€‘ìÙ6€OªG½â¿bÒ0h®ú“ëB2–<r½€¥¾*0"'#”TSGF~تšq!ŽHæäÜ8±ÁðÇlEØ\†¡Ñœ(Bf ¹øÕÍÄU/&ZðdÄ t›ýA fÌV£¬‡ìŠJ«Œ¬>‚q(6—a¨4'ŠŒ€»ËÌäëç˜ HPV°Äq/IlÐØ*'$ÀK[iÚŠIƒ¦9QL˜J„ç(p°jHÏXJHΘ K Ét,¿o›âvŽÙçc+&=…k  OغƒkÆ«ÕË‚jYÍéÌâøÿCÿMõÎF'O!#Òî¯Ú'ÿ–s^ãoÊ;6Êð09í$£ž£4üKþ ?ÀOâ­cõarRQhÞårB~›Ì_ßÚ`o”aOGÝñü7ÒuØÈäSX'ëå´mŠt!¡¦Çs <Ý.ÅŒSrÂ8Ú’ÈëÄ ó¶/Ý0®æ”%E cà4k(ƳaÜ›“‰BbBI˜á˜¯–<^9rA83ºÀɪO:k®Ù–KLj‚Ççð:Ãæ¢à„mŠ+XhªOøUY¶†QÒ®(rbÞÐ3$mg†aÀ)ÛAÙ +Aù$X;~W" «>Ýàd¢Ð Ù~®þ¿zxŠ†Ñ íVŸîÃK~~=iéžHÄ´}9FwèñºOÕh‹û¬ ´Z7Š…Íœ3VôXPt‡Í¸–˜ÜÜÂ:=Eu1ÝuÞÞ¾û‹Aˆ¢º”òÎåË;Ë+{²CWŠ2ÅÖEm/eC×â7ºÆ Ea÷¡¿]²w@ü±:m‡Ä EA¹V¬aìÅ°Ea`¢0Œ& èa¢0Œ& è1lQبµq& è1lQƘ( £Æ`}ŸÄóy^žëgÛ¶ÅèƒÈ{|ȵ3Á`Œ~0äêÓ·x¿m3Œ¾1dQ|€wÚ6ÃèCÅ›À÷x«m3Œ¾1à6Èû¨~¼m+Œ¾1ìHFßæeÛ&ý£eQˆ?VXù+ù€—?Y›ë=lÚnSĦþ_j Õ¨Q›Öi½úÔè]·‘´›({Œ.ÑvIaÃDa5L†QÃDa5L†QÃDa5L†QÃDa5L†QÃDa5z- Id)ÉÖ»+ÂÓK,K±µÇ=hÝ÷é^,(·Þ]EJŒE©0ö ×¢ÐLÜJ’‘HLDF@Á…æR€Ìqd:‰Ê LpL12ØXÑëêÓ Òuˆ–”Ç’2‰˜2cB@¢9BfXÐ`c‹^—Ûl—š z±åä="Õ 1àˆ¹ÐTà‰•Æ.ƒÅŒ‰dª@FÀŒ·šñg’0.¡­>Hîql°~¹Ü~­0GYâQ”/¢„ŒPc¹>&^ãOe³=úðhy5It|òszü}æûµa³qJFõiÍm‰~ã&†ÓûdGÂDa5L†QÃDa5L†QÃDa5L†QÃDa5L†QÃDa5ÚvóȯšBz4~š?ç›GOÕæñ œa‡÷JH-ÀŠ±/V}2Œ& èa¢0Œ& èa¢0ŒÃ…õ<0lQƘ( £†‰Â0j vD[<_áàcjnÆ^ ¶¤ÐœïðˆG¼Û¶%F߬(€÷Lƾ Yoðå¶Í0úÆ`Û ž¯ñoK(û1`Q€<ç#ýTÛV}£íIFÍòM>jÛ£ [¿ÇwÛ6Áèî>9 ÊbìÏ€E!Žðääj‹ïWH€Ã“S¨Eú»†A‰BB6Bðäd€Ç¯(ÈÉÉNù!ÏJžÈ(€ÈÈ€ÔD²a ¢OŒ#'»ùË•R !™.îž~GDHN 7/ß !âIY<œÛÅõô^âˆ(˜íSEZÿ`ö:ª?HH¤û ¿:jñÐW@éµ($ fï¯~çøOª³¶¯äˆyâ‰Ê¨á‡Ýóïr»×—ÉÝôTG¯(Êw»B,SPSq·‹T£ ¹íH”‡>xœ½_\ÓkRŠYòÚ¾ž#åÊ;ü.ÁÒ ø]Þ¹öS‡2"bI|å±zcÚËêøpëuÂrõm–)à˜+ŒXÞj­c~Ì\ìï8ÅòEþ#9¸œ€ª-âYð“m_ΑÈøKF’ZNÀº¬øqÝZdš Ä\*e5“›RÈVǃäëשD,剫´àÈo³¸ÚóhôWðUýuqD2?¤m°[MhtñÎSò—: Iä jåº-r~§f{7´WC$z&!sÎ1Ót=prNLNȘçLÉuLL 1)1éf8¦žfÛÙ!_äŸîlø%¹u<µè=º ]öï}ª†H$ÔT&Œ*ŸÊÕÀÉxSSGJ …”÷‡Œ\g’éBæ¤[Ã1—Òl7;ô—ùe ù%^ÇñðfÛ§gÿêSÀBS}¢)è„`5NYnåGÉAW–šâ7÷]Ͷª&[i¶¦ú‹ú“úˆ3þâ;6âjÃqw;*‚²£w·æš½/»÷EN U_òˆ ’í­ü_"wUµtÙIéŠ4»ƒ¦ú‹]lótšQõ;؃²³E1;0×ìíö?þì_}Z ‘Œ%Äi*¹L¯·þ¿+!™ŽÅá%œ8r¼ÄTƒ.›á˜Ú°‹Õ‹ûNz»Oký|bí{{‹B3^]g@ •SÝfëãµñ×­^O€YõœV©•ãõ¯bôñe—‰Ž%&"#d¬©Ä„« §$›Žñ¥ß*³u'Måߺé¨ûÄBå;Û:Wü?þîÆ#VÏViî{™Aºy ã«.“19NÇJ@® )Öwú펖§c 6*ÿÖ—|bÏ+ïÛpë\åe«k† Jûˆ ye£!vºLŠê/¼¡SbF Kv;Tnè¨:aŠ+ÏU²Ii•ö1Q{s©Ë çú~§@ÏXìÑ¡Ró‰½âóUJ«´ˆUŸŒCXù©:¼xB<_àMñ8qZÙVGK(Ž‚”tÝ¡W¾µ\ë®÷Øñ‰­öÛtÍŒª´HoWóð¶ÕŒöJ-ƈð1¯c(y²?ý­>eü+2TTGb™ò^Û—s$~X¦ÇhtJ S~¸í‹i‹Þ–`ë>]yM'X÷ièôZ`+^s}¶Bà=è½(ªË°µd/_«­%{ Eu1¶êøå<±UÇ÷fP¢¨]šÅ§¸‹Oq;ÿs*LË>7¢÷%tEXtdate:create2013-04-23T16:33:29+02:00e²Ô%tEXtdate:modify2013-04-23T16:33:29+02:00K htEXtps:HiResBoundingBox394x499+0+0í§tEXtps:LevelAdobe-2.0 EPSF-2.0 þZIEND®B`‚gprolog-1.4.5/doc/debug-box.pdf0000644000175000017500000001265013021352245014437 0ustar spaspa%PDF-1.4 1 0 obj << /Pages 2 0 R /Type /Catalog >> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 3 0 obj << /Type /Page /Parent 2 0 R /Resources << /XObject << /Im0 8 0 R >> /ProcSet 6 0 R >> /MediaBox [0 0 283 88] /CropBox [0 0 283 88] /Contents 4 0 R /Thumb 11 0 R >> endobj 4 0 obj << /Length 5 0 R >> stream q 283 0 0 88 0 0 cm /Im0 Do Q endstream endobj 5 0 obj 30 endobj 6 0 obj [ /PDF /Text /ImageC ] endobj 7 0 obj << >> endobj 8 0 obj << /Type /XObject /Subtype /Image /Name /Im0 /Filter [ /RunLengthDecode ] /Width 283 /Height 88 /ColorSpace 10 0 R /BitsPerComponent 8 /SMask 15 0 R /Length 9 0 R >> stream žÿ“‚ÿÓÿ“‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿÁÿÏÿÿÿËÿ—ÿÂÿÿÿÓÿÿÒÿûÿ—ÿØÿéÿÒÿÿÿÒÿüÿÿ—ÿØÿüúÿýÿúÿþÞÿøÿÿÿÿüÿΗÿÍþÿüÿþÿÿÿÝÿÿýÿÿÿÿÿüÿΗÿÍþÿüÿÿÿÿÝÿýÿþÿÿÿÿÒÿüÿÿ—ÿØÿüúÿÿÿÿþÿÿÿÝÿÿýÿÿÿÿÿÒÿûÿ—ÿØÿöÿúÿùÞÿýÿöÌÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿÐÿÿÌÿ‚ÿÓÿÐÿýõÿÙÿ‚ÿÓÿÐÿôÿÙÿ‚ÿÓÿáÿôÿÿûÿøÿúÞÿ‚ÿÓÿáÿÿýÿÿúÿÿÿÿýÿÿÿüßÿ‚ÿÓÿáÿÿÿþÿÿþÿ ÿÿÿýÿþÿÿÜÿ‚ÿÓÿáÿÿÿþÿÿÿÿþÿÿÿÿý ÿÿÿÿÿßÿ‚ÿÓÿáÿùÿðÿôßÿ‚ÿÓÿáÿ¹ÿ‚ÿÓÿáÿ¹ÿ‚ÿÓÿáÿþºÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ•ÿüÿÿÿËÿ—ÿÁÿØÿýþÿÿËÿ—ÿÁÿØÿ÷ÿõÿØÿ—ÿûÿÈÿÙÿúÿÿÿùÿüØÿ—ÿÿÿüÓÿùÿýÿüÞÿ ÿÿÿÿÿÿýÿÍ—ÿÎýÿÿÿûÿÿÿÞÿÿÿþÿÿÿÿýÿÍ—ÿÎýÿÿÿÿÿÿÿÿÿÞÿ ÿÿÿÿÿÿùÿüØÿ—ÿÿÿüÓÿÿÿÿÿÿÿÿÿßÿóöÿØÿ—ÿûÿÓÿþÿòœÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ—ÿ‚ÿÓÿ“‚ÿÓÿ“‚ÿÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿ‚ÿßÿŠÿ‚ÿâÿÿŠÿ‚ÿãÿçÿ¢ÿ‚ÿüÿýÿóÿ÷ÿüÿüúÿü¢ÿ‚ÿüÿüÿþÿÿøÿýÿÿÿÿÿÿþÿ—‚ÿüÿüÿÿþÿþÿÿÿþÿÿÿÿÿÿÿþÿ—‚ÿüÿÿÿÿþÿÿýÿÿþÿÿþÿÿÿÿÿÿÿúÿü‚ÿ›ÿúÿûÿìÿû÷ÿ‚ÿ‡ÿ‚ÿ‚ÿæÿ‚ÿ‚ÿæÿþ‚ÿ‚ÿÿÿ€ endstream endobj 9 0 obj 1670 endobj 10 0 obj /DeviceGray endobj 11 0 obj << /Filter [ /RunLengthDecode ] /Width 106 /Height 33 /ColorSpace 10 0 R /BitsPerComponent 8 /Length 12 0 R >> stream ‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚¼€ endstream endobj 12 0 obj 57 endobj 13 0 obj endobj 14 0 obj 57 endobj 15 0 obj << /Type /XObject /Subtype /Image /Name /Ma0 /Filter [ /RunLengthDecode ] /Width 283 /Height 88 /ColorSpace /DeviceGray /BitsPerComponent 8 /Length 16 0 R >> stream ž•D‚ÓDw—DwD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DDÁDÏUUËDD—DDªÓ3ÿ3ÿÒûDD—DDØéªÒÿÿÒŸÝÈ’3DD—DDØçϯ`úwˆ»Dî3ªD3ÝwÝfÞwU™"ˆUˆÿÿü"ØD¾þÿøå×Ãi—DuØDçþÿíÛÄuþˆfDÌDwªUÿD»ÝˆDU"DUÿÿÿü"ØD¾þÿøå×Ãi—DuØDçþÿíÛÄuþ»üÝDÿD»Ý»"ýwDÿÿÿÒŸÝÈ’3DD—DDØçϯ`ú™w3wDÌÿD»Ý™w3wwÿÿÿÒûDD—DDØö3î»™Dˆª™@ÿ3"ÝfÞ"Ý»ˆwÌfÌU3ÿ33ÿ3ÌDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDDÐ"DÌDD‚ÓDDЈˆªõÙDD‚ÓDDÐDˆôªÙDD‚ÓDDá&f»ˆÌffªªˆwˆ»fU™ˆ3ÝwU™"ˆUˆwÝfwˆ»ÞDD‚ÓDDá'D»îD̈fDÌDwUDˆÿˆDU"DUÿD»ˆfDÌDßDD‚ÓDDá D»ÌD»»þ »DDˆÿ»"ýwDÿD»»ÜDD‚ÓDDá'D»ÌD»™w3™fDˆÿ™w3wwÿD»™w3ßDD‚ÓDDá'DÝUw3wÝ33î»™3݈™Ì@ÿ3"Ý»ˆwÌfÌU"Ýf3î»™ßDD‚ÓDDáD»¹DD‚ÓDDáD»¹DD‚ÓDDá3DºDD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD•UUüDUËDD—DDÁ"؈ˆ"þª3ÿËDD—DDÁˆˆØ»÷ÿõØDD—DDûÈDˆÙ fÿˆ?ˆUˆ3Ýÿù`¯ÏêØDD—DD3’ÈݧÓfªªˆwˆ»fU™ˆwUª3Þ ÿDUÿÿÿýuÄÛíþÿçØDuD—iÃ×åøþÿ¾ØD"ýD̈fDÌ›UDˆwU"ÝÞ ÿwDÿÿÿýuÄÛíþÿçØDuD—iÃ×åøþÿ¾ØD"ýD»»»DDˆ»UÿÞ ÿwwÿÿÿù`¯ÏçØDD—DD3’ÈÝŸÓD»™w­fDˆˆˆÝß 3ÿUwÌfÌU3ÿ33ÿ3öØDD—DDûÓwÝ33î»™@݈™ÌªUwDœDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDD—DD‚ÓDw—DwD‚ÓÌDuuÌD‚DD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚‚æDD‚ßDŠDD‚⪊DD‚ãªç¢DD‚ü)wˆ»Dî3ªDwU™wˆ»f»ˆÌfwÝf3ÝwUª3f»ˆÌDú`¯Ïê¢DD‚ü)ˆfDÌDwªUˆDU"ˆfDÌDD»îD»ÿwU"ÝDÌUˆþuÄÛíþÿç¢DwD‚ü»üÝD»"þ»þD»ÌD»ÿ»UÿD»DˆþuÄÛíþÿç¡D‚ü)™w3wDÌ™w3™w3D»ÌD»ÿˆˆÝD»Dˆú`¯Ïç‚›*3î»™Dˆª™0Ý»ˆ3î»™DÝUw3"Ýf3ÿ3ªUwDfÝ"ˆª÷‚‡D»‚‚æD»‚‚æ3D‚‚€ endstream endobj 16 0 obj 2086 endobj 17 0 obj << /Title (debug-box) /CreationDate (D:20130423161413) /ModDate (D:20130423161413) /Producer (ImageMagick 6.6.9-7 2012-08-17 Q16 http://www.imagemagick.org) >> endobj xref 0 18 0000000000 65535 f 0000000010 00000 n 0000000059 00000 n 0000000118 00000 n 0000000298 00000 n 0000000380 00000 n 0000000398 00000 n 0000000436 00000 n 0000000457 00000 n 0000002326 00000 n 0000002346 00000 n 0000002374 00000 n 0000002576 00000 n 0000002595 00000 n 0000002611 00000 n 0000002630 00000 n 0000004908 00000 n 0000004929 00000 n trailer << /Size 18 /Info 17 0 R /Root 1 0 R >> startxref 5105 %%EOF gprolog-1.4.5/doc/README0000644000175000017500000001671213021324543012753 0ustar spaspa GNU-Prolog Documentation 1- Contents of this directory ----------------------------- This directory contains the source of the manual written in LaTeX and several target versions: - gprolog.dvi (DVI version) - gprolog.pdf (PDF version) - gprolog.ps (PostScript version) - gprolog.html (HTML version entirely in one page) - gprolog.chm (Compressed HTML used by MS HTMLHelp under Win32) The html_node directory contains the HTML version in several pages (on per node) (files index.html, gprolog*.html) This manual is also available at http://www.gprolog.org/manual By default, the installation procedure copies each version in a directory INSTALL_DIR/doc (see file ../INSTALL for more details). 2- Rebuilding the manual ------------------------ Each version can be reconstructed using the Makefile (type 'make help' for a brief summary of available targets). Be sure to have the following environment before trying to rebuild the manual: - LaTeX2e (with standard packages) is needed to rebuild the DVI version. - dvips is needed to rebuild the PostScript version from the DVI. - pdflatex is needed to rebuild the PDF version. - HeVeA (version >= 1.06) is required to rebuild the HTML version. HeVeA can be obtained at http://hevea.inria.fr/ - The HTML Help compiler is needed to rebuild the HTML Help version (see below). 3- The HTML Help Version ------------------------ Microsoft HTML Help (HH for short) is the standard help system for the Win32 platforms (replacing old WinHelp). It is mainly based on HTML files + add-ons (table of contents, index, search facilities,...). A SDK is freely available as a "HTML Help Workshop". To obtain more information and/or the workshop consult: http://msdn.microsoft.com/library/en-us/htmlhelp/html/vsconHH1Start.asp To install the workshop consult the file src/WINDOWS. The HH version of the manual is constructed from the HTML files (html_node/index.html and html_node/gprolog*.html) using a HH project (.hhp) which includes a HH table of contents (.hhc) and a HH index (.hhk). The .hhc and .hhk files are constructed wih HeVeA with a script hh_do_hhc_hhk and 2 .tex files. The result is a compressed (or compiled) HTML file (.chm). The user does not need the entire HTML Help Workshop to view a .chm, only a runtime called "Help Viewer" is necessary. It is provided with recent versions of windows (e.g Windows XP). Else a viewer can be downloaded (file: HHUPD.EXE) from the same URL (also available in C:\Program Files\HTML Help Workshop\REDIST). The .chm version is used by the Win32 GUI Console of GNU Prolog. HTML Help File Formats ---------------------- This information is get from: http://parthe.lpthe.jussieu.fr/~zeitlin/wxWindows/docs/wxwin495.htm#helpformat wxHTML library uses a reduced version of MS HTML Workshop format. Tex2RTF can produce these files when generating HTML, if you set htmlWorkshopFiles to true in your tex2rtf.ini file. (See wxHtmlHelpController for help controller description.) A book consists of three files: header file, contents file and index file. You can make a regular zip archive of these files, plus the HTML and any image files, for wxHTML (or helpview) to read; and the .zip file can optionally be renamed to .htb. Header file (.hhp) Header file must contain these lines (and may contain additional lines which are ignored) : Contents file= Index file= Title= Default topic=<default page to be displayed.htm> All filenames (including the Default topic) are relative to the location of .hhp file. Localization note: In addition, .hhp file may contain line Charset=<rfc_charset> which specifies what charset (e.g. "iso8859_1") was used in contents and index files. Please note that this line is incompatible with MS HTML Help Workshop and it would either silently remove it or complain with some error. See also Writing non-English applications. Contents file (.hhc) Contents file has HTML syntax and it can be parsed by regular HTML parser. It contains exactly one list (<ul>....</ul> statement): <ul> <li> <object type="text/sitemap"> <param name="Name" value="@topic name@"> <param name="ID" value=@numeric_id@> <param name="Local" value="@filename.htm@"> </object> <li> <object type="text/sitemap"> <param name="Name" value="@topic name@"> <param name="ID" value=@numeric_id@> <param name="Local" value="@filename.htm@"> </object> ... </ul> You can modify value attributes of param tags. topic name is name of chapter/topic as is displayed in contents, filename.htm is HTML page name (relative to .hhp file) and numeric_id is optional - it is used only when you use wxHtmlHelpController::Display(int) Items in the list may be nested - one <li> statement may contain a <ul> sub-statement: <ul> <li> <object type="text/sitemap"> <param name="Name" value="Top node"> <param name="Local" value="top.htm"> </object> <ul> <li> <object type="text/sitemap"> <param name="Name" value="subnode in topnode"> <param name="Local" value="subnode1.htm"> </object> ... </ul> <li> <object type="text/sitemap"> <param name="Name" value="Another Top"> <param name="Local" value="top2.htm"> </object> ... </ul> Index file (.hhk) Index files have same format as contents file except that ID params are ignored. HEVEA SPECIFIC In LaTeX the \index{word} refers the current section no. Classically we have \section{section title} ... \index{word}. In HeVeA the corresponding HTML anchor is defined at the position the \index{word} appears. This is a problem if we want to associate an index to (a word appearing in) a section title. Clicking on the 'word' in the HTML index will show the page starting from 'word' and not from the section title (which is hidden). Previously we tried to reference the section for anchors in the index using this in custom.hva: %To get index citations that point to section titles %this comes from /usr/lib/hevea/makeidx.hva %NB: no longer works in HeVeA 2.0 !!! % %\usepackage{makeidx} %\renewcommand{\index}[1] %{\if@refs\@saveclosed% %\@@indexwrite[default]{#1}{\@currentlabel}{htoc\thetocanchor}%force evaluation %\@restoreclosed\fi} However this no longer works in HeVeA 2.0. The solution consisted in writing \section{...\index{...}...}. NB: LaTeX removes \index (and \label) when generating the TOC (see addcontentsline in file .toc). Using macros is OK but not \if in macros (else they are not expansed and the \index will appear in the TOC resulting in a wrong index (TOC lines referenced). If the \if is really necessary the are 2 other possibilities: 1) deactivate the macro(s) appearing in the \section whose expansion give a \index before the table of contents and reactivate after. E.g., (let us suppose it is IdxPBD): let\saveIdxPBD=\IdxPBD \renewcommand{\IdxPBD}[1] {\texttt{#1}} \tableofcontents \let\IdxPBD=\saveIdxPBD 2) Define a macro to emit such a subsection (e.g., let us suppose it is as subsubsection) with 2 args: the section title and the index entry/ies. For LaTeX, define \section and then \index. For HeVeA do the reverse: \index and then \section in macros.tex: \newcommand{\SSSect}[2]{\subsubsection{#1}#2} and in custom.hva \newcommand{\SSSect}[2]{#2\subsubsection{#1}} Use as follows: \SSSect{\texttt{var/1}, \texttt{nonvar/1}} {\AddPBD{var/1} \AddPBD{nonvar/1}} ������������������������������������������������������gprolog-1.4.5/doc/intro.tex�������������������������������������������������������������������������0000644�0001750�0001750�00000013676�13021324543�013756� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{GNU Prolog License Conditions} GNU Prolog is free software. Since version 1.4.0, GNU Prolog distributed under a dual license: LGPL \textit{or} GPL. So, you can redistribute it and/or modify it under the terms of either: \begin{description} \item[] -- the GNU Lesser General Public License (LGPL) as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. \item[] \textbf{or} \item[] -- the GNU General Public License (GPL) as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. \item[] \textbf{or} both in parallel (as here). \end{description} GNU Prolog 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 copies of the GNU General Public License and the GNU Lesser General Public License along with this program. If not, see \MyUrl{http://www.gnu.org/licenses/}{http://www.gnu.org/licenses/}. Remark: versions of GNU Prolog prior to 1.4.0 were entirely released under the GNU General Public License (GPL). \section{Introduction} GNU Prolog \cite{gnu-prolog} is a free Prolog compiler with constraint solving over finite domains developed by \MyUrl{http://cri-dist.univ-paris1.fr/diaz/}{Daniel Diaz}. For recent information about GNU Prolog please consult \MyUrl{http://www.gprolog.org}{the GNU Prolog page}. \index{Warren Abstract Machine|see {WAM}} GNU Prolog is a Prolog compiler based on the Warren Abstract Machine (\IdxD{WAM}) \cite{Warren83,Ait-Kaci91}. It first compiles a Prolog program to a WAM file which is then translated to a low-level machine independent language called \Idx{mini-assembly} specifically designed for GNU Prolog. The resulting file is then translated to the assembly language of the target machine (from which an object is obtained). This allows GNU Prolog to produce a native stand alone executable from a Prolog source (similarly to what does a C compiler from a C program). The main advantage of this compilation scheme is to produce native code and to be fast. Another interesting feature is that executables are small. Indeed, the code of most unused built-in predicates is not included in the executables at link-time. A lot of work has been devoted to the ISO compatibility. Indeed, GNU Prolog is very close to the ISO standard for Prolog~\cite{iso-part1}. GNU Prolog also offers various extensions very useful in practice (global variables, OS interface, sockets,...). In particular, GNU Prolog contains an efficient constraint solver over Finite Domains (FD). This opens constraint logic programming to the user combining the power of constraint programming to the declarativity of logic programming. The key feature of the GNU Prolog solver is the use of a single (low-level) primitive to define all (high-level) FD constraints. There are many advantages of this approach: constraints can be compiled, the user can define his own constraints (in terms of the primitive), the solver is open and extensible (as opposed to black-box solvers like CHIP),\ldots Moreover, the GNU Prolog solver is rather efficient, often more than commercial solvers. GNU Prolog is inspired from two systems developed by the same author: \begin{itemize} \item \texttt{wamcc}: a Prolog to C compiler \cite{wamcc}. the key point of \texttt{wamcc} was its ability to produce stand alone executables using an original compilation scheme: the translation of Prolog to C via the WAM. Its drawback was the time needed by \texttt{gcc} to compile the produced sources. GNU Prolog can also produce stand alone executables but using a faster compilation scheme. \item \texttt{clp(FD)}: a constraint programming language over FD \cite{long-clp-fd}. Its key feature was the use of a single primitive to define FD constraints. GNU Prolog is based on the same idea but offers an extended constraint definition language. In comparison to \texttt{clp(FD)}, GNU Prolog offers new predefined constraints, new predefined heuristics, reified constraints,\ldots \end{itemize} Here are some features of GNU Prolog: \begin{itemize} \item Prolog system: \begin{itemize} \item conforms to the ISO standard for Prolog (floating point numbers, streams, dynamic code,\dots). \item a lot of extensions: global variables, definite clause grammars (DCG), sockets interface, operating system interface,\ldots \item more than 300 Prolog built-in predicates. \item Prolog debugger and a low-level WAM debugger. \item line editing facility under the interactive interpreter with completion on atoms. \item powerful bidirectional interface between Prolog and C. \end{itemize} \item Compiler: \begin{itemize} \item native-code compiler producing stand alone executables. \item simple command-line compiler accepting a wide variety of files: Prolog files, C files, WAM files,\ldots \item direct generation of assembly code 15 times faster than \texttt{wamcc} + \texttt{gcc}. \item most of unused built-in predicates are not linked (to reduce the size of the executables). \item compiled predicates (native-code) as fast as \texttt{wamcc} on average. \item consulted predicates (byte-code) 5 times faster than \texttt{wamcc}. \end{itemize} \item Constraint solver: \begin {itemize} \item FD variables well integrated into the Prolog environment (full compatibility with Prolog variables and integers). No need for explicit FD declarations. \item very efficient FD solver (comparable to commercial solvers). \item high-level constraints can be described in terms of simple primitives. \item a lot of predefined constraints: arithmetic constraints, boolean constraints, symbolic constraints, reified constraints,\ldots \item several predefined enumeration heuristics. \item the user can define his own new constraints. \item more than 50 FD built-in constraints/predicates. \end{itemize} \end{itemize} ������������������������������������������������������������������gprolog-1.4.5/doc/debugger.tex����������������������������������������������������������������������0000644�0001750�0001750�00000036241�13021324543�014400� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{Debugging} \label{Debugging} %HEVEA\cutdef[1]{subsection} \subsection{Introduction} The GNU Prolog debugger provides information concerning the control flow of the program. The debugger can be fully used on consulted predicates (i.e. byte-code). For native compiled code only the calls/exits are traced, no internal behavior is shown. Under the debugger it is possible to exhaustively trace the execution or to set spy-points to only debug a specific part of the program. Spy-points allow the user to indicate on which predicates the debugger has to stop to allow the user to interact with it. The debugger uses the ``procedure box control flow model'', also called the Byrd Box model since it is due to Lawrence Byrd. \subsection{The procedure box model} The procedure box model of Prolog execution provides a simple way to show the control flow. This model is very popular and has been adopted in many Prolog systems (e.g. SICStus Prolog, Quintus Prolog,\ldots). A good introduction is the chapter 8 of ``Programming in Prolog'' of Clocksin \& Mellish~\cite{Clock}. The debugger executes a program step by step tracing an invocation to a predicate (\texttt{call}) and the return from this predicate due to either a success (\texttt{exit}) or a failure (\texttt{fail}). When a failure occurs the execution backtracks to the last predicate with an alternative clause. The predicate is then re-invoked (\texttt{redo}). Another source of change of the control flow is due to exceptions. When an exception is raised from a predicate (\texttt{exception}) by \IdxPB{throw/1} \RefSP{catch/3} the control is given back to the most recent predicate that has defined a handler to recover this exception using \IdxPB{catch/3} \RefSP{catch/3}. The procedure box model shows these different changes in the control flow, as illustrated here: \InsertImage{debug-box} Each arrow corresponds to a \emph{port}. An arrow to the box indicates that the control is given to this predicate while an arrow from the box indicates that the control is given back from the procedure. This model visualizes the control flow through these five ports and the connections between the boxes associated with subgoals. Finally, it should be clear that a box is associated with one invocation of a given predicate. In particular, a recursive predicate will give raise to a box for each invocation of the predicate with different entries/exits in the control flow. Since this might get confusing for the user, the debugger associates with each box a unique identifier (i.e. the invocation number). \subsection{Debugging predicates} \subsubsection{\AddDBD{trace/0}% \AddDBD{debug/0}% \AddDBD{debugging/0}% \AddDBD{notrace/0}% \AddDBD{nodebug/0}% \AddDBD{wam\_debug/0}% Running and stopping the debugger \label{Running-and-stopping-the-debugger}} \texttt{trace/0} activates the debugger. The next invocation of a predicate will be traced. \texttt{debug/0} activates the debugger. The next invocation of a predicate on which a spy-point has been set will be traced. It is important to understand that the information associated with the control flow is only available when the debugger is on. For efficiency reasons, when the debugger is off the information concerning the control flow (i.e. the boxes) is not retained. So, if the debugger is activated in the middle of a computation (by a call to \texttt{debug/0} or \texttt{trace/0} in the program or after the interrupt key sequence (\texttt{Ctl-C}) by choosing \texttt{trace} or \texttt{debug}), information prior to this point is not available. \texttt{debugging/0}: prints onto the terminal information about the current debugging state (whether the debugger is switched on, what are the leashed ports, spy-points defined,\ldots). \texttt{notrace/0} or \texttt{nodebug/0} switches the debugger off. \texttt{wam\_debug/0} invokes the sub-debugger devoted to the WAM data structures \RefSP{The-WAM-debugger}. It can be also invoked using the \texttt{W} debugger command \RefSP{Debugger-commands}. \subsubsection{\AddDBD{leash/1}% Leashing ports \label{Leashing-ports}} \texttt{leash(Ports)} requests the debugger to prompt the user, as he creeps through the program, for every port defined in the \texttt{Ports} list. Each element of \texttt{Ports} is an atom in \texttt{call}, \texttt{exit}, \texttt{redo}, \texttt{fail}, \texttt{exception}. \texttt{Ports} can also be an atom defining a shorthand: \begin{itemize} \item \IdxDKD{full}: equivalent to \texttt{[call, exit, redo, fail, exception]} \item \IdxDKD{half}: equivalent to \texttt{[call, redo]} \item \IdxDKD{loose}: equivalent to \texttt{[call]} \item \IdxDKD{none}: equivalent to \texttt{[]} \item \IdxDKD{tight}: equivalent to \texttt{[call, redo, fail, exception]} \end{itemize} When an unleashed port is encountered the debugger continues to show the associated goal but does not stop the execution to prompt the user. \subsubsection{% \AddDBD{spy/1}% \AddDBD{nospy/1}% \AddDBD{nospyall/0}% \AddDBD{spypoint\_condition/3}% Spy-points \label{Spy-points}} When dealing with big sources it is not very practical to creep through the entire program. It is preferable to define a set of spy-points on interesting predicates to be prompted when the debugger reaches one of these predicates. Spy-points can be added either using \texttt{spy/1} (or \texttt{spypoint\_condition/3}) or dynamically when prompted by the debugger using the \texttt{+} (or \texttt{*}) debugger command \RefSP{Debugger-commands}. The current mode of leashing does not affect spy-points in the sense that user interaction is requested on every port. \texttt{spy(PredSpec)} sets a spy-point on all the predicates given by \texttt{PredSpec}. \texttt{PredSpec} defines one or several predicates and has one of the following forms: \begin{itemize} \item \texttt{[PredSpec1, PredSpec2,\ldots]}: set a spy-point for each element of the list. \item \texttt{Name}: set a spy-point for any predicate whose name is \texttt{Name} (whatever the arity). \item \texttt{Name/Arity}: set a spy-point for the predicate whose name is \texttt{Name} and arity is \texttt{Arity}. \item \texttt{Name/A1-A2}: set a spy-point for the each predicate whose name is \texttt{Name} and arity is between \texttt{A1} and \texttt{A2}. \end{itemize} It is not possible to set a spy-point on an undefined predicate. The following predicate is used to remove one or several spy-points: \texttt{nospy(PredSpec)} removes the spy-points from the specified predicates. \texttt{nospyall/0} removes all spy-points: It is also possible to define conditional spy-points. \texttt{spypoint\_condition(Goal, Port, Test)} sets a conditional spy-point on the predicate for \texttt{Goal}. When the debugger reaches a conditional spy-point it only shows the associated goal if the following conditions are verified: \begin{itemize} \item the actual goal unifies with \texttt{Goal}. \item the actual port unifies with \texttt{Port}. \item the Prolog goal \texttt{Test} succeeds. \end{itemize} \subsection{Debugging messages} We here described which information is displayed by the debugger when it shows a goal. The basic format is as follows: \OneLine{\Param{S N M Port}:~\Param{Goal} ?} \Param{S} is a spy-point indicator: if there is a spy-point on the current goal the \texttt{+} symbol is displayed else a space is displayed. \Param{N} is the invocation number. This unique number can be used to correlate the trace messages for the various ports, since it is unique for every invocation. \Param{M} is an index number which represents the number of direct ancestors of the goal (i.e. the current depth of the goal). \Param{Port} specifies the particular port (\texttt{call}, \texttt{exit}, \texttt{fail}, \texttt{redo}, \texttt{exception}). \Param{Goal} is the current goal (it is then possible to inspect its current instantiation) which is displayed using \IdxPB{write\_term/3} with \texttt{quoted(true)} and \texttt{max\_depth(\Param{D})} options \RefSP{write-term/3}. Initially \Param{D} (the print depth) is set to 10 but can be redefined using the \texttt{{\lt}} debugger command \RefSP{Debugger-commands}. The \texttt{?} symbol is displayed when the debugger is waiting a command from the user. (i.e. \texttt{Port} is a leashed port). If the port is unleashed, this symbol is not displayed and the debugger continues the execution displaying the next goal. \subsection{Debugger commands} \label{Debugger-commands} When the debugger reaches a leashed port it shows the current goal followed by the \texttt{?} symbol. At this point there are many commands available. Typing \texttt{RETURN} will creep into the program. Continuing to creep will show all the control flow. The debugger shows every port for every predicate encountered during the execution. It is possible to select the ports at which the debugger will prompt the user using the built-in predicate \IdxDB{leash/1} \RefSP{Leashing-ports}. Each command is only one character long: \begin{tabular}{|c|c|p{10.4cm}|} \hline Command & Name & Description \\ \hline\hline \texttt{RET} or \texttt{c} & creep & single-step to the next port \\ \hline \texttt{l} & leap & continue the execution only stopping when a goal with a spy-point is reached \\ \hline \texttt{s} & skip & skip over the entire execution of the current goal. No message will be shown until control returns \\ \hline \texttt{G} & go to & ask for an invocation number and continue the execution until a port is reached for that invocation number \\ \hline \texttt{r} & retry & try to restart the invocation of the current goal by failing until reaching the invocation of the goal. The state of execution is the same as when the goal was initially invoked (except when using side-effect predicates) \\ \hline \texttt{f} & fail & force the current goal to fail immediately \\ \hline \texttt{w} & write & show the current goal using \texttt{write/2} \RefSP{write-term/3} \\ \hline \texttt{d} & display & show the current goal using \texttt{display/2} \RefSP{write-term/3} \\ \hline \texttt{p} & print & show the current goal using \texttt{print/2} \RefSP{write-term/3} \\ \hline \texttt{e} & exception & show the pending exception. Only applicable to an \texttt{exception} port \\ \hline \texttt{g} & ancestors & show the list of ancestors of the current goal \\ \hline \texttt{A} & alternatives & show the list of ancestors of the current goal combined with choice-points \\ \hline \texttt{u} & unify & ask for a term and unify the current goal with this term. This is convenient for getting a specific solution. Only available at a \texttt{call} port \\ \hline \texttt{.} & father file & show the Prolog file name and the line number where the current predicate is defined \\ \hline \texttt{n} & no debug & switch the debugger off. Same as \IdxDB{nodebug/0} \RefSP{Running-and-stopping-the-debugger} \\ \hline \texttt{=} & debugging & show debugger information. Same as \IdxDB{debugging/0} \RefSP{Running-and-stopping-the-debugger} \\ \hline \texttt{+} & spy this & set a spy-point on the current goal. Uses \IdxDB{spy/1} \RefSP{Spy-points} \\ \hline \texttt{-} & nospy this & remove a spy-point on the current goal. Uses \IdxDB{nospy/1} \RefSP{Spy-points} \\ \hline \texttt{*} & spy conditionally & ask for a term \texttt{Goal, Port, Test} (terminated by a dot) and set a conditional spy-point on the current predicate. \texttt{Goal} and the current goal must have the same predicate indicator. Uses \IdxDB{spypoint\_condition/3} \RefSP{Spy-points} \\ \hline \texttt{L} & listing & list all the clauses associated with the current predicate. Uses \IdxPB{listing/1} \RefSP{listing/1} \\ \hline \texttt{a} & abort & abort the current execution. Same as \IdxPB{abort/0} \RefSP{abort/0} \\ \hline \texttt{b} & break & invoke a recursive top-level. Same as \IdxPB{break/0} \RefSP{abort/0} \\ \hline \texttt{@} & execute goal & ask for a goal and execute it \\ \hline \texttt{{\lt}} & set print depth & ask for an integer and set the print depth to this value (\texttt{-1} for no depth limit) \\ \hline \texttt{h} or \texttt{?} & help & display a summary of available commands \\ \hline \texttt{W} & WAM debugger & invoke the low-level WAM debugger \RefSP{The-WAM-debugger} \\ \hline \end{tabular} \subsection{The WAM debugger} \label{The-WAM-debugger} In some cases it is interesting to have access to the \Idx{WAM} data structures. This sub-debugger allows the user to inspect/modify the contents of any stack or register of the WAM. The WAM debugger is invoked using the built-in predicate \IdxDB{wam\_debug/0} \RefSP{Running-and-stopping-the-debugger} or the \texttt{W} debugger command \RefSP{Debugger-commands}. The following table presents the specific commands of the WAM debugger: \begin{tabular}{|l|l|} \hline Command & Description \\ \hline\hline \texttt{write} \Param{A} [\Param{N}] & write \Param{N} terms starting at the address \Param{A} using \texttt{write/1} \RefSP{write-term/3} \\ \hline \texttt{data} \Param{A} [\Param{N}] & display \Param{N} words starting at the address \Param{A} \\ \hline \texttt{modify} \Param{A} [\Param{N}] & display and modify \Param{N} words starting at the address \Param{A} \\ \hline \texttt{where} \Param{A} & display the real address corresponding to \Param{A} \\ \hline \texttt{what} \Param{RA} & display what corresponds to the real address \Param{RA} \\ \hline \texttt{deref} \Param{A} & display the dereferenced word starting at the address \Param{A} \\ \hline \texttt{envir} [\Param{SA}] & display the contents of the environment located at \Param{SA} (or the current one) \\ \hline \texttt{backtrack} [\Param{SA}] & display the contents of the choice-point located at \Param{SA} (or the current one) \\ \hline \texttt{backtrack all} & display all choice-points \\ \hline \texttt{quit} & quit the WAM debugger \\ \hline \texttt{help} & display a summary of available commands \\ \hline \end{tabular} In the above table the following conventions apply: \begin{itemize} \item elements between [ and ] are optional. \item \Param{N} is an optional integer (defaults to 1). \item \Param{A} is a WAM address, its syntax is: \Param{BANK\_NAME} [ \texttt{[ \Param{N} ]} ], i.e. a bank name possibly followed by an index (defaults to 0). \Param{BANK\_NAME} is either: \begin{itemize} \item \texttt{reg}: WAM general register (stack pointers, continuation, ...). \item \texttt{x}: WAM X register (temporary variables, i.e. arguments). \item \texttt{y}: WAM Y register (permanent variables). \item \texttt{ab}: WAM X register saved in the current choice-point. \item \Param{STACK\_NAME}: WAM stack (\Param{STACK\_NAME} in \texttt{local}, \texttt{global}, \texttt{trail}, \texttt{cstr}). \end{itemize} \item \Param{SA} is a WAM stack address, i.e. \texttt{\Param{STACK\_NAME}} [ \texttt{[ \Param{N} ]} ] (special case of WAM addresses). \item \Param{RA} is a real address, its syntax is the syntax of C integers (in particular the notation \texttt{0x\ldots} is recognized). \end{itemize} It is possible to only use the first letters of a commands and bank names when there is no ambiguity. Also the square brackets \texttt{[} \texttt{]} enclosing the index of a bank name can be omitted. For instance the following command (showing the contents of 25 consecutive words of the global stack from the index 3): \texttt{data global[3] 25} can be abbreviated as: \texttt{d g 3 25}. %HEVEA\cutend ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/compil-scheme.eps�����������������������������������������������������������������0000644�0001750�0001750�00000040161�13021324543�015324� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%!PS-Adobe-2.0 EPSF-2.0 %%Title: rfig3.eps %%Creator: fig2dev Version 3.2 Patchlevel 1 %%CreationDate: Mon Mar 8 16:52:59 1999 %%For: aude@borba.inria.fr (Jean-Christophe Aude) %%Orientation: Portrait %%BoundingBox: 0 0 394 499 %%Pages: 0 %%BeginSetup %%EndSetup %%Magnification: 1.0000 %%EndComments /$F2psDict 200 dict def $F2psDict begin $F2psDict /mtrx matrix put /col-1 {0 setgray} bind def /col0 {0.000 0.000 0.000 srgb} bind def /col1 {0.000 0.000 1.000 srgb} bind def /col2 {0.000 1.000 0.000 srgb} bind def /col3 {0.000 1.000 1.000 srgb} bind def /col4 {1.000 0.000 0.000 srgb} bind def /col5 {1.000 0.000 1.000 srgb} bind def /col6 {1.000 1.000 0.000 srgb} bind def /col7 {1.000 1.000 1.000 srgb} bind def /col8 {0.000 0.000 0.560 srgb} bind def /col9 {0.000 0.000 0.690 srgb} bind def /col10 {0.000 0.000 0.820 srgb} bind def /col11 {0.530 0.810 1.000 srgb} bind def /col12 {0.000 0.560 0.000 srgb} bind def /col13 {0.000 0.690 0.000 srgb} bind def /col14 {0.000 0.820 0.000 srgb} bind def /col15 {0.000 0.560 0.560 srgb} bind def /col16 {0.000 0.690 0.690 srgb} bind def /col17 {0.000 0.820 0.820 srgb} bind def /col18 {0.560 0.000 0.000 srgb} bind def /col19 {0.690 0.000 0.000 srgb} bind def /col20 {0.820 0.000 0.000 srgb} bind def /col21 {0.560 0.000 0.560 srgb} bind def /col22 {0.690 0.000 0.690 srgb} bind def /col23 {0.820 0.000 0.820 srgb} bind def /col24 {0.500 0.190 0.000 srgb} bind def /col25 {0.630 0.250 0.000 srgb} bind def /col26 {0.750 0.380 0.000 srgb} bind def /col27 {1.000 0.500 0.500 srgb} bind def /col28 {1.000 0.630 0.630 srgb} bind def /col29 {1.000 0.750 0.750 srgb} bind def /col30 {1.000 0.880 0.880 srgb} bind def /col31 {1.000 0.840 0.000 srgb} bind def end save -69.0 516.0 translate 1 -1 scale /cp {closepath} bind def /ef {eofill} bind def /gr {grestore} bind def /gs {gsave} bind def /sa {save} bind def /rs {restore} bind def /l {lineto} bind def /m {moveto} bind def /rm {rmoveto} bind def /n {newpath} bind def /s {stroke} bind def /sh {show} bind def /slc {setlinecap} bind def /slj {setlinejoin} bind def /slw {setlinewidth} bind def /srgb {setrgbcolor} bind def /rot {rotate} bind def /sc {scale} bind def /sd {setdash} bind def /ff {findfont} bind def /sf {setfont} bind def /scf {scalefont} bind def /sw {stringwidth} bind def /tr {translate} bind def /tnt {dup dup currentrgbcolor 4 -2 roll dup 1 exch sub 3 -1 roll mul add 4 -2 roll dup 1 exch sub 3 -1 roll mul add 4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} bind def /shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul 4 -2 roll mul srgb} bind def /reencdict 12 dict def /ReEncode { reencdict begin /newcodesandnames exch def /newfontname exch def /basefontname exch def /basefontdict basefontname findfont def /newfont basefontdict maxlength dict def basefontdict { exch dup /FID ne { dup /Encoding eq { exch dup length array copy newfont 3 1 roll put } { exch newfont 3 1 roll put } ifelse } { pop pop } ifelse } forall newfont /FontName newfontname put newcodesandnames aload pop 128 1 255 { newfont /Encoding get exch /.notdef put } for newcodesandnames length 2 idiv { newfont /Encoding get 3 1 roll put } repeat newfontname newfont definefont pop end } def /isovec [ 8#200 /grave 8#201 /acute 8#202 /circumflex 8#203 /tilde 8#204 /macron 8#205 /breve 8#206 /dotaccent 8#207 /dieresis 8#210 /ring 8#211 /cedilla 8#212 /hungarumlaut 8#213 /ogonek 8#214 /caron 8#220 /dotlessi 8#230 /oe 8#231 /OE 8#240 /space 8#241 /exclamdown 8#242 /cent 8#243 /sterling 8#244 /currency 8#245 /yen 8#246 /brokenbar 8#247 /section 8#250 /dieresis 8#251 /copyright 8#252 /ordfeminine 8#253 /guillemotleft 8#254 /logicalnot 8#255 /endash 8#256 /registered 8#257 /macron 8#260 /degree 8#261 /plusminus 8#262 /twosuperior 8#263 /threesuperior 8#264 /acute 8#265 /mu 8#266 /paragraph 8#267 /periodcentered 8#270 /cedilla 8#271 /onesuperior 8#272 /ordmasculine 8#273 /guillemotright 8#274 /onequarter 8#275 /onehalf 8#276 /threequarters 8#277 /questiondown 8#300 /Agrave 8#301 /Aacute 8#302 /Acircumflex 8#303 /Atilde 8#304 /Adieresis 8#305 /Aring 8#306 /AE 8#307 /Ccedilla 8#310 /Egrave 8#311 /Eacute 8#312 /Ecircumflex 8#313 /Edieresis 8#314 /Igrave 8#315 /Iacute 8#316 /Icircumflex 8#317 /Idieresis 8#320 /Eth 8#321 /Ntilde 8#322 /Ograve 8#323 /Oacute 8#324 /Ocircumflex 8#325 /Otilde 8#326 /Odieresis 8#327 /multiply 8#330 /Oslash 8#331 /Ugrave 8#332 /Uacute 8#333 /Ucircumflex 8#334 /Udieresis 8#335 /Yacute 8#336 /Thorn 8#337 /germandbls 8#340 /agrave 8#341 /aacute 8#342 /acircumflex 8#343 /atilde 8#344 /adieresis 8#345 /aring 8#346 /ae 8#347 /ccedilla 8#350 /egrave 8#351 /eacute 8#352 /ecircumflex 8#353 /edieresis 8#354 /igrave 8#355 /iacute 8#356 /icircumflex 8#357 /idieresis 8#360 /eth 8#361 /ntilde 8#362 /ograve 8#363 /oacute 8#364 /ocircumflex 8#365 /otilde 8#366 /odieresis 8#367 /divide 8#370 /oslash 8#371 /ugrave 8#372 /uacute 8#373 /ucircumflex 8#374 /udieresis 8#375 /yacute 8#376 /thorn 8#377 /ydieresis] def /Courier-Bold /Courier-Bold-iso isovec ReEncode /Times-Roman /Times-Roman-iso isovec ReEncode /$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def /$F2psEnd {$F2psEnteredState restore end} def %%EndProlog $F2psBegin 10 setmiterlimit n -1000 9594 m -1000 -1000 l 8707 -1000 l 8707 9594 l cp clip 0.06000 0.06000 sc /Times-Roman-iso ff 180.00 scf sf 2325 1950 m gs 1 -1 sc (WAM) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 2175 m gs 1 -1 sc (files) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 450 m gs 1 -1 sc (Prolog) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 675 m gs 1 -1 sc (files) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 3435 m gs 1 -1 sc (mini-assembly) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 3660 m gs 1 -1 sc (files) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 4935 m gs 1 -1 sc (assembly) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 5160 m gs 1 -1 sc (files) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 6525 m gs 1 -1 sc (object) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 6750 m gs 1 -1 sc (files) dup sw pop neg 0 rm col0 sh gr /Times-Roman-iso ff 180.00 scf sf 6600 3450 m gs 1 -1 sc (FD constraint) col0 sh gr /Times-Roman-iso ff 180.00 scf sf 6600 3675 m gs 1 -1 sc (definition files) col0 sh gr /Times-Roman-iso ff 180.00 scf sf 5850 8250 m gs 1 -1 sc (Prolog/FD libraries) col0 sh gr /Times-Roman-iso ff 180.00 scf sf 5850 8475 m gs 1 -1 sc (and user libraries) col0 sh gr % Polyline 7.500 slw gs clippath 3499 6601 m 3375 6600 l 3485 6543 l 3353 6574 l 3367 6633 l cp clip n 5850 6000 m 3375 6600 l gs col0 s gr gr % arrowhead n 3499 6601 m 3375 6600 l 3485 6543 l 3492 6572 l 3499 6601 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3029 855 m 3000 975 l 2969 855 l 2970 990 l 3030 990 l cp clip n 2998 671 m 3000 975 l gs col0 s gr gr % arrowhead n 3029 855 m 3000 975 l 2969 855 l 2999 855 l 3029 855 l cp gs 0.00 setgray ef gr col0 s % Polyline n 2287 975 m 3787 975 l 3787 1500 l 2287 1500 l cp gs col0 s gr % Polyline gs clippath 3029 1680 m 3000 1800 l 2969 1680 l 2970 1815 l 3030 1815 l cp clip n 2998 1496 m 3000 1800 l gs col0 s gr gr % arrowhead n 3029 1680 m 3000 1800 l 2969 1680 l 2999 1680 l 3029 1680 l cp gs 0.00 setgray ef gr col0 s % Polyline n 2287 2475 m 3787 2475 l 3787 3000 l 2287 3000 l cp gs col0 s gr % Polyline gs clippath 3029 2355 m 3000 2475 l 2969 2355 l 2970 2490 l 3030 2490 l cp clip n 2998 2171 m 3000 2475 l gs col0 s gr gr % arrowhead n 3029 2355 m 3000 2475 l 2969 2355 l 2999 2355 l 3029 2355 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3029 3180 m 3000 3300 l 2969 3180 l 2970 3315 l 3030 3315 l cp clip n 2998 2996 m 3000 3300 l gs col0 s gr gr % arrowhead n 3029 3180 m 3000 3300 l 2969 3180 l 2999 3180 l 3029 3180 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3029 3855 m 3000 3975 l 2969 3855 l 2970 3990 l 3030 3990 l cp clip n 2998 3671 m 3000 3975 l gs col0 s gr gr % arrowhead n 3029 3855 m 3000 3975 l 2969 3855 l 2999 3855 l 3029 3855 l cp gs 0.00 setgray ef gr col0 s % Polyline n 2287 3975 m 3787 3975 l 3787 4500 l 2287 4500 l cp gs col0 s gr % Polyline gs clippath 3029 4680 m 3000 4800 l 2969 4680 l 2970 4815 l 3030 4815 l cp clip n 2998 4496 m 3000 4800 l gs col0 s gr gr % arrowhead n 3029 4680 m 3000 4800 l 2969 4680 l 2999 4680 l 3029 4680 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3029 5355 m 3000 5475 l 2969 5355 l 2970 5490 l 3030 5490 l cp clip n 2998 5171 m 3000 5475 l gs col0 s gr gr % arrowhead n 3029 5355 m 3000 5475 l 2969 5355 l 2999 5355 l 3029 5355 l cp gs 0.00 setgray ef gr col0 s % Polyline n 2287 5475 m 3787 5475 l 3787 6000 l 2287 6000 l cp gs col0 s gr % Polyline gs clippath 3029 6180 m 3000 6300 l 2969 6180 l 2970 6315 l 3030 6315 l cp clip n 2998 5996 m 3000 6300 l gs col0 s gr gr % arrowhead n 3029 6180 m 3000 6300 l 2969 6180 l 2999 6180 l 3029 6180 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3029 7080 m 3000 7200 l 2969 7080 l 2970 7215 l 3030 7215 l cp clip n 2998 6896 m 3000 7200 l gs col0 s gr gr % arrowhead n 3029 7080 m 3000 7200 l 2969 7080 l 2999 7080 l 3029 7080 l cp gs 0.00 setgray ef gr col0 s % Polyline n 2212 7199 m 3712 7199 l 3712 7724 l 2212 7724 l cp gs col0 s gr % Polyline gs clippath 3029 7905 m 3000 8025 l 2969 7905 l 2970 8040 l 3030 8040 l cp clip n 2998 7721 m 3000 8025 l gs col0 s gr gr % arrowhead n 3029 7905 m 3000 8025 l 2969 7905 l 2999 7905 l 3029 7905 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 5880 3855 m 5851 3975 l 5820 3855 l 5821 3990 l 5881 3990 l cp clip n 5849 3671 m 5851 3975 l gs col0 s gr gr % arrowhead n 5880 3855 m 5851 3975 l 5820 3855 l 5850 3855 l 5880 3855 l cp gs 0.00 setgray ef gr col0 s % Polyline n 5100 3975 m 6600 3975 l 6600 4500 l 5100 4500 l cp gs col0 s gr % Polyline gs clippath 5880 4680 m 5851 4800 l 5820 4680 l 5821 4815 l 5881 4815 l cp clip n 5849 4496 m 5851 4800 l gs col0 s gr gr % arrowhead n 5880 4680 m 5851 4800 l 5820 4680 l 5850 4680 l 5880 4680 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 5880 5355 m 5851 5475 l 5820 5355 l 5821 5490 l 5881 5490 l cp clip n 5849 5171 m 5851 5475 l gs col0 s gr gr % arrowhead n 5880 5355 m 5851 5475 l 5820 5355 l 5850 5355 l 5880 5355 l cp gs 0.00 setgray ef gr col0 s % Polyline n 5100 5475 m 6600 5475 l 6600 6000 l 5100 6000 l cp gs col0 s gr % Polyline gs clippath 3534 8355 m 3414 8325 l 3534 8295 l 3399 8295 l 3399 8355 l cp clip n 4950 8325 m 3414 8325 l gs col0 s gr gr % arrowhead n 3534 8355 m 3414 8325 l 3534 8295 l 3534 8325 l 3534 8355 l cp gs 0.00 setgray ef gr col0 s /Courier-Bold-iso ff 180.00 scf sf 3375 1275 m gs 1 -1 sc (pl2wam) dup sw pop neg 0 rm col0 sh gr /Courier-Bold-iso ff 180.00 scf sf 3352 2775 m gs 1 -1 sc (wam2ma) dup sw pop neg 0 rm col0 sh gr /Courier-Bold-iso ff 180.00 scf sf 2700 4257 m gs 1 -1 sc (ma2asm) col0 sh gr /Courier-Bold-iso ff 180.00 scf sf 2700 7518 m gs 1 -1 sc (linker) col0 sh gr /Courier-Bold-iso ff 180.00 scf sf 5640 4275 m gs 1 -1 sc (fd2c) col0 sh gr /Times-Roman-iso ff 180.00 scf sf 6600 4950 m gs 1 -1 sc (C files) col0 sh gr /Courier-Bold-iso ff 180.00 scf sf 5325 5775 m gs 1 -1 sc (C compiler) col0 sh gr /Courier-Bold-iso ff 180.00 scf sf 2564 5775 m gs 1 -1 sc (assembler) col0 sh gr /Times-Roman-iso ff 180.00 scf sf 2325 8400 m gs 1 -1 sc (executable) dup sw pop neg 0 rm col0 sh gr % Polyline n 2587 646 m 2587 300 l 3418 300 l 3418 577 l gs col-1 s gr % Polyline n 3418 577 m 3415 576 l 3410 574 l 3400 570 l 3386 566 l 3368 560 l 3349 554 l 3328 548 l 3307 543 l 3286 539 l 3267 537 l 3248 536 l 3229 538 l 3210 542 l 3194 547 l 3177 553 l 3160 560 l 3141 569 l 3122 580 l 3102 591 l 3082 604 l 3061 617 l 3040 631 l 3019 644 l 2998 657 l 2978 670 l 2957 681 l 2938 691 l 2918 700 l 2900 707 l 2882 712 l 2864 716 l 2845 718 l 2825 719 l 2805 717 l 2783 713 l 2760 708 l 2736 701 l 2710 693 l 2685 684 l 2661 675 l 2639 667 l 2620 659 l 2605 653 l 2595 649 l 2590 647 l 2587 646 l gs col-1 s gr % Polyline n 2587 2146 m 2587 1800 l 3418 1800 l 3418 2077 l gs col-1 s gr % Polyline n 3418 2077 m 3415 2076 l 3410 2074 l 3400 2070 l 3386 2066 l 3368 2060 l 3349 2054 l 3328 2048 l 3307 2043 l 3286 2039 l 3267 2037 l 3248 2036 l 3229 2038 l 3210 2042 l 3194 2047 l 3177 2053 l 3160 2060 l 3141 2069 l 3122 2080 l 3102 2091 l 3082 2104 l 3061 2117 l 3040 2131 l 3019 2144 l 2998 2157 l 2978 2170 l 2957 2181 l 2938 2191 l 2918 2200 l 2900 2207 l 2882 2212 l 2864 2216 l 2845 2218 l 2825 2219 l 2805 2217 l 2783 2213 l 2760 2208 l 2736 2201 l 2710 2193 l 2685 2184 l 2661 2175 l 2639 2167 l 2620 2159 l 2605 2153 l 2595 2149 l 2590 2147 l 2587 2146 l gs col-1 s gr % Polyline n 2587 3646 m 2587 3300 l 3418 3300 l 3418 3577 l gs col-1 s gr % Polyline n 3418 3577 m 3415 3576 l 3410 3574 l 3400 3570 l 3386 3566 l 3368 3560 l 3349 3554 l 3328 3548 l 3307 3543 l 3286 3539 l 3267 3537 l 3248 3536 l 3229 3538 l 3210 3542 l 3194 3547 l 3177 3553 l 3160 3560 l 3141 3569 l 3122 3580 l 3102 3591 l 3082 3604 l 3061 3617 l 3040 3631 l 3019 3644 l 2998 3657 l 2978 3670 l 2957 3681 l 2938 3691 l 2918 3700 l 2900 3707 l 2882 3712 l 2864 3716 l 2845 3718 l 2825 3719 l 2805 3717 l 2783 3713 l 2760 3708 l 2736 3701 l 2710 3693 l 2685 3684 l 2661 3675 l 2639 3667 l 2620 3659 l 2605 3653 l 2595 3649 l 2590 3647 l 2587 3646 l gs col-1 s gr % Polyline n 2587 5146 m 2587 4800 l 3418 4800 l 3418 5077 l gs col-1 s gr % Polyline n 3418 5077 m 3415 5076 l 3410 5074 l 3400 5070 l 3386 5066 l 3368 5060 l 3349 5054 l 3328 5048 l 3307 5043 l 3286 5039 l 3267 5037 l 3248 5036 l 3229 5038 l 3210 5042 l 3194 5047 l 3177 5053 l 3160 5060 l 3141 5069 l 3122 5080 l 3102 5091 l 3082 5104 l 3061 5117 l 3040 5131 l 3019 5144 l 2998 5157 l 2978 5170 l 2957 5181 l 2938 5191 l 2918 5200 l 2900 5207 l 2882 5212 l 2864 5216 l 2845 5218 l 2825 5219 l 2805 5217 l 2783 5213 l 2760 5208 l 2736 5201 l 2710 5193 l 2685 5184 l 2661 5175 l 2639 5167 l 2620 5159 l 2605 5153 l 2595 5149 l 2590 5147 l 2587 5146 l gs col-1 s gr % Arc gs n 3019.5 6181.0 678.0 118.1 61.9 arcn gs col-1 s gr gr % Arc gs n 3019.5 5821.0 678.0 118.1 61.9 arcn gs col-1 s gr gr % Arc gs n 3019.5 7017.0 678.0 -61.9 -118.1 arcn gs col-1 s gr gr % Polyline n 3339 6779 m 3339 6419 l gs col-1 s gr % Polyline n 2700 6419 m 2700 6779 l gs col-1 s gr % Arc gs n 3019.5 7907.0 678.0 118.1 61.9 arcn gs col-1 s gr gr % Arc gs n 3019.5 7547.0 678.0 118.1 61.9 arcn gs col-1 s gr gr % Arc gs n 3019.5 8743.0 678.0 -61.9 -118.1 arcn gs col-1 s gr gr % Polyline n 3339 8505 m 3339 8145 l gs col-1 s gr % Polyline n 2700 8145 m 2700 8505 l gs col-1 s gr % Polyline n 5426 3646 m 5426 3300 l 6257 3300 l 6257 3577 l gs col-1 s gr % Polyline n 6257 3577 m 6254 3576 l 6249 3574 l 6239 3570 l 6225 3566 l 6207 3560 l 6188 3554 l 6167 3548 l 6146 3543 l 6125 3539 l 6106 3537 l 6087 3536 l 6068 3538 l 6049 3542 l 6033 3547 l 6016 3553 l 5999 3560 l 5980 3569 l 5961 3580 l 5941 3591 l 5921 3604 l 5900 3617 l 5879 3631 l 5858 3644 l 5837 3657 l 5817 3670 l 5796 3681 l 5777 3691 l 5757 3700 l 5739 3707 l 5721 3712 l 5703 3716 l 5684 3718 l 5664 3719 l 5644 3717 l 5622 3713 l 5599 3708 l 5575 3701 l 5549 3693 l 5524 3684 l 5500 3675 l 5478 3667 l 5459 3659 l 5444 3653 l 5434 3649 l 5429 3647 l 5426 3646 l gs col-1 s gr % Polyline n 5426 5146 m 5426 4800 l 6257 4800 l 6257 5077 l gs col-1 s gr % Polyline n 6257 5077 m 6254 5076 l 6249 5074 l 6239 5070 l 6225 5066 l 6207 5060 l 6188 5054 l 6167 5048 l 6146 5043 l 6125 5039 l 6106 5037 l 6087 5036 l 6068 5038 l 6049 5042 l 6033 5047 l 6016 5053 l 5999 5060 l 5980 5069 l 5961 5080 l 5941 5091 l 5921 5104 l 5900 5117 l 5879 5131 l 5858 5144 l 5837 5157 l 5817 5170 l 5796 5181 l 5777 5191 l 5757 5200 l 5739 5207 l 5721 5212 l 5703 5216 l 5684 5218 l 5664 5219 l 5644 5217 l 5622 5213 l 5599 5208 l 5575 5201 l 5549 5193 l 5524 5184 l 5500 5175 l 5478 5167 l 5459 5159 l 5444 5153 l 5434 5149 l 5429 5147 l 5426 5146 l gs col-1 s gr % Arc gs n 5325.5 7907.0 678.0 118.1 61.9 arcn gs col-1 s gr gr % Arc gs n 5325.5 7547.0 678.0 118.1 61.9 arcn gs col-1 s gr gr % Arc gs n 5325.5 8743.0 678.0 -61.9 -118.1 arcn gs col-1 s gr gr % Polyline n 5645 8505 m 5645 8145 l gs col-1 s gr % Polyline n 5006 8145 m 5006 8505 l gs col-1 s gr $F2psEnd rs ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/pl-bips.tex�����������������������������������������������������������������������0000644�0001750�0001750�00001130233�13021324543�014157� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{Prolog built-in predicates} %HEVEA\cutdef[1]{subsection} \subsection{Type testing} \subsubsection{\IdxPBD{var/1}, \label{var/1} \IdxPBD{nonvar/1}, \IdxPBD{atom/1}, \IdxPBD{integer/1}, \IdxPBD{float/1}, \IdxPBD{number/1}, \IdxPBD{atomic/1}, \\ \IdxPBD{compound/1}, \IdxPBD{callable/1}, \IdxPBD{ground/1}, \IdxPBD{is\_list/1}, \IdxPBD{list/1}, \\ \IdxPBD{partial\_list/1}, \IdxPBD{list\_or\_partial\_list/1}} \begin{TemplatesTwoCols} var(?term)\\ nonvar(?term)\\ atom(?term)\\ integer(?term)\\ float(?term)\\ number(?term)\\ atomic(?term)\\ compound(?term)\\ callable(?term)\\ ground(?term)\\ is\_list(?term)\\ list(?term)\\ partial\_list(?term)\\ list\_or\_partial\_list(?term) \end{TemplatesTwoCols} \Description \texttt{var(Term)} succeeds if \texttt{Term} is currently uninstantiated (which therefore has not been bound to anything, except possibly another uninstantiated variable). \texttt{nonvar(Term)} succeeds if \texttt{Term} is currently instantiated (opposite of \texttt{var/1}). \texttt{atom(Term)} succeeds if \texttt{Term} is currently instantiated to an atom. \texttt{integer(Term)} succeeds if \texttt{Term} is currently instantiated to an integer. \texttt{float(Term)} succeeds if \texttt{Term} is currently instantiated to a floating point number. \texttt{number(Term)} succeeds if \texttt{Term} is currently instantiated to an integer or a floating point number. \texttt{atomic(Term)} succeeds if \texttt{Term} is currently instantiated to an atom, an integer or a floating point number. \texttt{compound(Term)} succeeds if \texttt{Term} is currently instantiated to a compound term, i.e. a term of arity $>$ 0 (a list or a structure). \texttt{callable(Term)} succeeds if \texttt{Term} is currently instantiated to a callable term, i.e. an atom or a compound term. \texttt{ground(Term)} succeeds if \texttt{Term} is a ground term. \texttt{list(Term)} succeeds if \texttt{Term} is currently instantiated to a list, i.e. the atom \texttt{[]} (empty list) or a term with principal functor \texttt{'.'/2} and with second argument (the tail) a list. \texttt{is\_list(Term)} behaves like \texttt{list(Term)} (for compatibility purpose). \texttt{partial\_list(Term)} succeeds if \texttt{Term} is currently instantiated to a partial list, i.e. a variable or a term whose the main functor is \texttt{'.'/2} and the second argument (the tail) is a partial list. \texttt{list\_or\_partial\_list(Term)} succeeds if \texttt{Term} is currently instantiated to a list or a partial list. \PlErrorsNone \Portability \texttt{var/1}, \texttt{nonvar/1}, \texttt{atom/1}, \texttt{integer/1}, \texttt{float/1}, \texttt{number/1}, \texttt{atomic/1}, \texttt{compound/1} \texttt{callable/1} and \texttt{ground/1} are ISO predicates. \texttt{list/1}, \texttt{partial\_list/1} and \texttt{list\_or\_partial\_list/1} are GNU Prolog predicates. \subsection{Term unification} \subsubsection{\IdxPBD{(=)/2} - Prolog unification} \begin{TemplatesOneCol} =(?term, ?term) \end{TemplatesOneCol} \Description \texttt{Term1 = Term2} unifies \texttt{Term1} and \texttt{Term2}. No occurs check is done, i.e. this predicate does not check if a variable is unified with a compound term containing this variable (this can lead to an infinite loop). \texttt{=} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. \PlErrorsNone \Portability ISO predicate. \subsubsection{\IdxPBD{unify\_with\_occurs\_check/2}} \begin{TemplatesOneCol} unify\_with\_occurs\_check(?term, ?term) \end{TemplatesOneCol} \Description \texttt{unify\_with\_occurs\_check(Term1, Term2)} unifies \texttt{Term1} and \texttt{Term2}. The occurs check test is done (i.e. the unification fails if a variable is unified with a compound term containing this variable). \PlErrorsNone \Portability ISO predicate. \subsubsection{\IdxPBD{({\bs}=)/2} - not Prolog unifiable} \begin{TemplatesOneCol} {\bs}=(?term, ?term) \end{TemplatesOneCol} \Description \texttt{Term1 {\bs}= Term2} succeeds if \texttt{Term1} and \texttt{Term2} are not unifiable (no occurs check is done). \texttt{{\bs}=} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. \PlErrorsNone \Portability ISO predicate. \subsection{Term comparison} \subsubsection{Standard total ordering of terms} \label{Standard-total-ordering-of-terms} The built-in predicates described in this section allows the user to compare Prolog terms. Prolog terms are totally ordered according to the standard total ordering of terms which is as follows (from the smallest term to the greatest): \begin{itemize} \item variables, oldest first. \item finite domain variables \RefSP{Finite-Domain-variables}, oldest first. \item floating point numbers, in numeric order. \item integers, in numeric order. \item atoms, in alphabetical (i.e. character code) order. \item compound terms, ordered first by arity, then by the name of the principal functor and by the arguments in left-to-right order. \end{itemize} A list is treated as a compound term (whose principal functor is \texttt{'.'/2}). The portability of the order of variables is not guaranteed (in the ISO reference the order of variables is system dependent). \subsubsection{\IdxPBD{(==)/2} - term identical, \label{(==)/2} \IdxPBD{({\bs}==)/2} - term not identical, \\ \AddPBD{("@{\lt})/2} % Pb with @ in \index with HeVeA \AddPBD{("@={\lt})/2} \AddPBD{("@{\gt})/2} \AddPBD{("@{\gt}=)/2} \texttt{(@{\lt})/2} - term less than, \texttt{(@={\lt})/2} - term less than or equal to, \\ \texttt{(@{\gt})/2} - term greater than, \texttt{(@{\gt}=)/2} - term greater than or equal to} \begin{TemplatesTwoCols} ==(?term, ?term)\\ {\bs}==(?term, ?term) \\ @{\lt}(?term, ?term) \\ @={\lt}(?term, ?term)\\ @{\gt}(?term, ?term)\\ @{\gt}=(?term, ?term) \end{TemplatesTwoCols} \Description These predicates compare two terms according to the standard total ordering of terms \RefSP{Standard-total-ordering-of-terms}. \texttt{Term1 == Term2} succeeds if \texttt{Term1} and \texttt{Term2} are equal. \texttt{Term1 {\bs}== Term2} succeeds if \texttt{Term1} and \texttt{Term2} are different. \texttt{Term1 @{\lt} Term2} succeeds if \texttt{Term1} is less than \texttt{Term2}. \texttt{Term1 @={\lt} Term2} succeeds if \texttt{Term1} is less than or equal to \texttt{Term2}. \texttt{Term1 @{\gt} Term2} succeeds if \texttt{Term1} is greater than \texttt{Term2}. \texttt{Term1 @{\gt}= Term2} succeeds if \texttt{Term1} is greater than or equal to \texttt{Term2}. \texttt{==}, \texttt{{\bs}==}, \texttt{@{\lt}}, \texttt{@={\lt}}, \texttt{@{\gt}} and \texttt{@{\gt}=} are predefined infix operators \RefSP{op/3:(Term-input/output)}. \PlErrorsNone \Portability ISO predicates. \subsubsection{\IdxPBD{compare/3} \label{compare/3}} \begin{TemplatesOneCol} compare(?atom, +term, +term) \end{TemplatesOneCol} \Description \texttt{compare(Order, Term1, Term2)} compares \texttt{Term1} and \texttt{Term2} according to the standard \RefSP{Standard-total-ordering-of-terms} and unifies \texttt{Order} with: \begin{itemize} \item the atom \texttt{{\lt}} if \texttt{Term1} is less than \texttt{Term2}. \item the atom \texttt{=} if \texttt{Term1} and \texttt{Term2} are equal. \item the atom \texttt{{\gt}} if \texttt{Term1} is greater than \texttt{Term2}. \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Order} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Order)} \ErrCond{\texttt{Order} is an atom but not \texttt{{\lt}}, \texttt{=} or \texttt{{\gt}}} \ErrTerm{domain\_error(order, Order)} \end{PlErrors} \Portability ISO predicate. \subsection{Term processing} \subsubsection{\IdxPBD{functor/3} \label{functor/3}} \begin{TemplatesOneCol} functor(+nonvar, ?atomic, ?integer)\\ functor(-nonvar, +atomic, +integer) \end{TemplatesOneCol} \Description \texttt{functor(Term, Name, Arity)} succeeds if the principal functor of \texttt{Term} is \texttt{Name} and its arity is \texttt{Arity}. This predicate can be used in two ways: \begin{itemize} \item \texttt{Term} is not a variable: extract the name (an atom or a number if \texttt{Term} is a number) and the arity of \texttt{Term} (if \texttt{Term} is atomic \texttt{Arity} = 0). \item \texttt{Term} is a variable: unify \texttt{Term} with a general term whose principal functor is given by \texttt{Name} and arity is given by \texttt{Arity}. \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Term} and \texttt{Name} are both variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Term} and \texttt{Arity} are both variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Term} is a variable and \texttt{Name} is neither a variable nor an atomic term} \ErrTerm{type\_error(atomic, Name)} \ErrCond{\texttt{Term} is a variable and \texttt{Arity} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Arity)} \ErrCond{\texttt{Term} is a variable, \texttt{Name} is a constant but not an atom and \texttt{Arity} is an integer $>$ 0} \ErrTerm{type\_error(atom, Name)} \ErrCond{\texttt{Term} is a variable and \texttt{Arity} is an integer $>$ \texttt{max\_arity} flag \RefSP{set-prolog-flag/2}} \ErrTerm{representation\_error(max\_arity)} \ErrCond{\texttt{Term} is a variable and \texttt{Arity} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Arity)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{arg/3} \label{arg/3}} \begin{TemplatesOneCol} arg(+integer, +compound\_term, ?term) \end{TemplatesOneCol} \Description \texttt{arg(N, Term, Arg)} succeeds if the \texttt{N}\emph{th} argument of \texttt{Term} is \texttt{Arg}. \begin{PlErrors} \ErrCond{\texttt{N} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Term} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \ErrCond{\texttt{Term} is neither a variable nor a compound term} \ErrTerm{type\_error(compound, Term)} \ErrCond{\texttt{N} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, N)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{(=..)/2} - univ \label{(=..)/2}} \begin{TemplatesOneCol} =..(+nonvar, ?list)\\ =..(-nonvar, +list) \end{TemplatesOneCol} \Description \texttt{Term =.. List} succeeds if \texttt{List} is a list whose head is the atom corresponding to the principal functor of \texttt{Term} and whose tail is a list of the arguments of \texttt{Term}. \texttt{=..} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. \begin{PlErrors} \ErrCond{\texttt{Term} is a variable and \texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{\texttt{Term} is a variable and \texttt{List} is a list whose head is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is a list whose head \texttt{H} is neither an atom nor a variable and whose tail is not the empty list} \ErrTerm{type\_error(atom, H)} \ErrCond{\texttt{List} is a list whose head \texttt{H} is a compound term and whose tail is the empty list} \ErrTerm{type\_error(atomic, H)} \ErrCond{\texttt{Term} is a variable and \texttt{List} is the empty list} \ErrTerm{domain\_error(non\_empty\_list, [])} \ErrCond{\texttt{Term} is a variable and the tail of \texttt{List} has a length $>$ \texttt{max\_arity} flag \RefSP{set-prolog-flag/2}} \ErrTerm{representation\_error(max\_arity)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{copy\_term/2}} \begin{TemplatesOneCol} copy\_term(?term, ?term) \end{TemplatesOneCol} \Description \texttt{copy\_term(Term1, Term2)} succeeds if \texttt{Term2} unifies with a term \texttt{T} which is a renamed copy of \texttt{Term1}. \PlErrorsNone \Portability ISO predicate. \subsubsection{\IdxPBD{term\_variables/2}, \IdxPBD{term\_variables/3}} \label{term_variables/2-3} \begin{TemplatesOneCol} term\_variables(?term, ?list)\\ term\_variables(?term, ?list, ?list)\\ \end{TemplatesOneCol} \Description \texttt{term\_variables(Term, List)} succeeds if \texttt{List} unifies with a list of variables (including FD variables), each sharing with a unique variable of \texttt{Term}. The variables in \texttt{List} are ordered in order of appearance traversing \texttt{Term} depth-first and left-to-right. \texttt{term\_variables(Term, List, Tail)} is a difference-list version of the above predicate, i.e. \texttt{Tail} is the tail of the variable-list \texttt{List}. \begin{PlErrors} \ErrCond{in \texttt{term\_variables/2} \texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \end{PlErrors} \Portability \texttt{term\_variables/2} is an ISO Predicate. \texttt{term\_variables/3} is a GNU Prolog predicate. \subsubsection{\IdxPBD{subsumes\_term/2}} \begin{TemplatesOneCol} subsumes\_term(?term, ?term) \end{TemplatesOneCol} \Description \texttt{subsumes\_term(General, Specific)} succeeds if \texttt{General} can be made equivalent to \texttt{Specific} by binding variables in \texttt{General} leaving \texttt{Specific} unaffected. The current implementation performs the unification (with occurs check) and ensures that the variable set of \texttt{Specific} is not changed by the unification (which is then undone). Note that this predicate fails in the presence of FD variables in \texttt{Specific}. \PlErrorsNone \Portability ISO predicate. \subsubsection{\IdxPBD{acyclic\_term/1}} \begin{TemplatesOneCol} acyclic\_term(?term) \end{TemplatesOneCol} \Description \texttt{acyclic\_term(Term)} succeeds if \texttt{Term} does not contain a cyclic (sub-)term. In this case, Term may be processed safely. If \texttt{acyclic\_term(Term)} fails, \texttt{Term} contains a cycle and processing Term is not safe, because GNU Prolog does not support the unification of cyclic terms but permits their creation. Cycles can be safely undone by failing over their creation. The use of \texttt{acyclic\_term/1} shall thus be reserved to protect critical predicates against cyclic terms. \PlErrorsNone \Portability ISO predicate. \subsubsection{\IdxPBD{term\_hash/4},\label{term-hash/4} \IdxPBD{term\_hash/2}} \begin{TemplatesOneCol} term\_hash(?term, +integer, +integer, ?integer) \\ term\_hash(?term, ?integer) \end{TemplatesOneCol} \Description \texttt{term\_hash(Term, Depth, Range, Hash)} succeeds if \texttt{Hash} is the \Idx{hash code} of \texttt{Term}. If \texttt{Term} is not ground (see \texttt{ground/1} \RefSP{var/1}), the predicate simply succeeds (\texttt{Hash} is not unified). \texttt{Depth} is the depth limit to scan \texttt{Term} (starting from 1 for the top-level term). With \texttt{Depth} = 0 nothing is hashed, with 1 only atomic terms and the main functors/arity are hashed,... With \texttt{Depth} = -1 the full term is considered. The hash code is as follows: $0 \leq$ \texttt{Hash} $<$ \texttt{Range}. If \texttt{Range} = 0 then \texttt{Hash} is not restricted (currently it is $<$ 268435456). \texttt{term\_hash(Term, Hash)} is equivalent to \texttt{term\_hash(Term, -1, 0, Hash)}. NB: the computed hash code is independent of any runtime context (i.e. it is constant across different executions). It is also independent on the underlying machine. These predicates are useful to implement hash tables or argument indexing. \begin{PlErrors} \ErrCond{\texttt{Depth} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Depth} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Depth)} \ErrCond{\texttt{Range} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Range} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Range)} \ErrCond{\texttt{Range} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Range)} \ErrCond{\texttt{Hash} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Hash)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{setarg/4}, \IdxPBD{setarg/3}} \begin{TemplatesOneCol} setarg(+integer, +compound\_term, +term, +boolean)\\ setarg(+integer, +compound\_term, +term) \end{TemplatesOneCol} \Description \texttt{setarg(N, Term, NewValue, Undo)} replaces destructively the \texttt{N}\emph{th} argument of \texttt{Term} with \texttt{NewValue}. This assignment is undone on backtracking if \texttt{Undo} = \texttt{true}. This should only used if there is no further use of the old value of the replaced argument. If \texttt{Undo} = \texttt{false} then \texttt{NewValue} must be either an atom or an integer. \texttt{setarg(N, Term, NewValue)} is equivalent to \texttt{setarg(N, Term, NewValue, true)}. \begin{PlErrors} \ErrCond{\texttt{N} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \ErrCond{\texttt{N} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, N)} \ErrCond{\texttt{Term} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Term} is neither a variable nor a compound term} \ErrTerm{type\_error(compound, Term)} \ErrCond{\texttt{NewValue} is neither an atom nor an integer and \texttt{Undo} = \texttt{false}} \ErrTerm{type\_error(atomic, NewValue)} \ErrCond{\texttt{Undo} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Undo} is neither a variable nor a boolean} \ErrTerm{type\_error(boolean, Undo)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Variable naming/numbering} \label{Variable-naming/numbering} \subsubsection{\IdxPBD{name\_singleton\_vars/1}\label{name-singleton-vars/1}} \begin{TemplatesOneCol} name\_singleton\_vars(?term) \end{TemplatesOneCol} \Description \texttt{name\_singleton\_vars(Term)} binds each singleton variable appearing in \texttt{Term} with a term of the form \texttt{'\$VARNAME'('\_')}. Such a term can be output by \texttt{write\_term/3} as a variable name \RefSP{write-term/3}. \PlErrorsNone \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{name\_query\_vars/2}\label{name-query-vars/2}} \begin{TemplatesOneCol} name\_query\_vars(+list, ?list) \end{TemplatesOneCol} \Description \texttt{name\_query\_vars(List, Rest)} for each element of \texttt{List} of the form \texttt{Name = Var} where \texttt{Name} is an atom and \texttt{Var} a variable, binds \texttt{Var} with the term \texttt{'\$VARNAME'(Name)}. Such a term can be output by \texttt{write\_term/3} as a variable name \RefSP{write-term/3}. \texttt{Rest} is unified with the list of elements of \texttt{List} that have not given rise to a binding. This predicate is provided as a way to name the variable lists obtained returned by \texttt{read\_term/3} with \AddPO{variable\_names}\texttt{variable\_names(List)} or \AddPO{singletons}\texttt{singletons(List)} options \RefSP{read-term/3}. \begin{PlErrors} \ErrCond{\texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \ErrCond{\texttt{Rest} is neither a partial list nor a list} \ErrTerm{type\_error(list, Rest)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{bind\_variables/2},\label{bind-variables/2} \IdxPBD{numbervars/3}, \IdxPBD{numbervars/1}} \begin{TemplatesOneCol} bind\_variables(?term, +var\_binding\_option\_list)\\ numbervars(?term, +integer, ?integer)\\ numbervars(?term) \end{TemplatesOneCol} \Description \texttt{bind\_variables(Term, Options)} binds each variable appearing in \texttt{Term} according to the options given by \texttt{Options}. \SPart{Variable binding options}: \texttt{Options} is a list of variable binding options. If this list contains contradictory options, the rightmost option is the one which applies. Possible options are: \begin{itemize} \item \IdxPOD{numbervars}: specifies that each variable appearing in \texttt{Term} should be bound to a term of the form \texttt{'\$VAR'(N)} where \texttt{N} is an integer. Such a term can be output by \texttt{write\_term/3} as a variable name \RefSP{write-term/3}. This is the default. \item \IdxPOD{namevars}: specifies that each variables appearing in \texttt{Term} shall be bound to a term of the form \texttt{'\$VARNAME'(Name)} where \texttt{Name} is the atom that would be output by \texttt{write\_term/3} seeing a term of the \texttt{'\$VAR'(N)} where \texttt{N} is an integer. Such a term can be output by \texttt{write\_term/3} as a variable name \RefSP{write-term/3}. This is the alternative to \texttt{numbervars}. \item \AddPOD{from}\texttt{from(From)}: the first integer \texttt{N} to use for number/name variables of \texttt{Term} is \texttt{From}. The default value is \texttt{0}. \item \AddPOD{next}\texttt{next(Next)}: when \texttt{bind\_variables/2} succeeds, \texttt{Next} is unified with the (last integer \texttt{N})+1 used to bind the variables of \texttt{Term}. \item \AddPOD{exclude}\texttt{exclude(List)}: collects all variable names appearing in \texttt{List} to avoid a clash when binding a variable of \texttt{Term}. Precisely a number \texttt{N} $\geq$ \texttt{From} will not be used to bind a variable of \texttt{Term} if: \begin{itemize} \item there is a sub-term of \texttt{List} of the form \texttt{'\$VAR'(N)} or \texttt{'\$VARNAME'(Name)} where \texttt{Name} is the constant that would be output by \texttt{write\_term/3} seeing a term of the \texttt{'\$VAR'(N)}. \item an element of \texttt{List} is of the form \texttt{Name = Var} where \texttt{Name} is an atom that would be output by \texttt{write\_term/3} on seeing a term of the from \texttt{'\$VAR'(N)}. This case allows for lists returned by \texttt{read\_term/3} (with \AddPO{variable\_names}\texttt{variable\_names(List)} or \AddPO{singletons}\texttt{singletons(List)} options) \RefSP{read-term/3} and by \texttt{name\_query\_vars/2} \RefSP{name-query-vars/2}. \end{itemize} \end{itemize} \texttt{numbervars(Term, From, Next)} is equivalent to \texttt{bind\_variables(Term, [from(From), next(Next)]}, i.e. each variable of \texttt{Term} is bound to \texttt{'\$VAR'(N)} where \texttt{From $\leq$} \texttt{N} $<$ \texttt{Next}. \texttt{numbervars(Term)} is equivalent to \texttt{numbervars(Term, 0, \_)}. See also \texttt{term\_variables} \RefSP{term_variables/2-3} which returns the set of variables of a term. \begin{PlErrors} \ErrCond{\texttt{Options} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is neither a partial list nor a list} \ErrTerm{type\_error(list, Options)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is neither a variable nor a variable binding option} \ErrTerm{domain\_error(var\_binding\_option, E)} \ErrCond{\texttt{From} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{From} is neither a variable nor an integer} \ErrTerm{type\_error(integer, From)} \ErrCond{\texttt{Next} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Next)} \ErrCond{\texttt{List} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List} is neither a partial list nor a list} \ErrTerm{type\_error(list, List)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{term\_ref/2}} \begin{TemplatesOneCol} term\_ref(+term, ?integer)\\ term\_ref(?term, +integer) \end{TemplatesOneCol} \Description \texttt{term\_ref(Term, Ref)} succeeds if the internal reference of \texttt{Term} is \texttt{Ref}. This predicate can be used either to obtain the internal reference of a term or to obtain the term associated with a given reference. Note that two identical terms can have different internal references. A good way to use this predicate is to first record the internal reference of a given term and to later re-obtain the term via this reference. \begin{PlErrors} \ErrCond{\texttt{Term} and \texttt{Ref} are both variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Ref} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Ref)} \ErrCond{\texttt{Ref} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Ref)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Arithmetic} \subsubsection{Evaluation of an arithmetic expression} \label{Evaluation-of-an-arithmetic-expression} An arithmetic expression is a Prolog term built from numbers, variables, and functors (or operators) that represent arithmetic functions. When an expression is evaluated each variable must be bound to a non-variable expression. An expression evaluates to a number, which may be an integer or a floating point number. The following table details the components of an arithmetic expression, how they are evaluated, the types expected/returned and if they are ISO or an extension: \newpage \tablehead{\hline Expression & Result = \textit{eval}(Expression) & Signature & ISO \\\hline\hline} \begin{supertabular}{|l|L{7.5cm}|c|c|} %HEVEA\hline Expression & Result = \textit{eval}(Expression) & Signature & ISO \\\hline\hline a variable & bound to an expression \texttt{E}, result is \textit{eval}(\texttt{E}) & IF $\rightarrow$ IF & Y \\ \hline an integer number & this number & I & Y \\ \hline a floating point number & this number & F & Y \\ \hline \texttt{pi} & the value of $\pi = 3.141592...$ & F & Y \\ \hline \texttt{e} & the value of $e = 2.718281...$ & F & N \\ \hline \texttt{epsilon} & difference between 1.0 and minimum float $>$ 1.0 & F & N \\ \hline \texttt{+ E} & \textit{eval}(\texttt{E}) & IF $\rightarrow$ IF & Y \\ \hline \texttt{- E} & - \textit{eval}(\texttt{E}) & IF $\rightarrow$ IF & Y \\ \hline \texttt{inc(E)} & \textit{eval}(\texttt{E}) + 1 & IF $\rightarrow$ IF & N \\ \hline \texttt{dec(E)} & \textit{eval}(\texttt{E}) - 1 & IF $\rightarrow$ IF & N \\ \hline \texttt{E1 + E2} & \textit{eval}(\texttt{E1}) + \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ IF & Y \\ \hline \texttt{E1 - E2} & \textit{eval}(\texttt{E1}) - \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ IF & Y \\ \hline \texttt{E1 * E2} & \textit{eval}(\texttt{E1}) * \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ IF & Y \\ \hline \texttt{E1 / E2} & \textit{eval}(\texttt{E1}) / \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ F & Y \\ \hline \texttt{E1 // E2} & \textit{rnd}(\textit{eval}(\texttt{E1}) / \textit{eval}(\texttt{E2})) & I, I $\rightarrow$ I & Y \\ \hline \texttt{E1 rem E2} & \textit{eval}(\texttt{E1}) - (\textit{rnd}(\textit{eval}(\texttt{E1}) / \textit{eval}(\texttt{E2})) * \textit{eval}(\texttt{E2})) & I, I $\rightarrow$ I & Y \\ \hline \texttt{E1 div E2} & $\lfloor$(\textit{eval}(\texttt{E1}) - \textit{eval}(\texttt{E1}) \texttt{mod} \textit{eval}(\texttt{E2})) / \textit{eval}(\texttt{E2})$\rfloor$ & I, I $\rightarrow$ I & Y \\ \hline \texttt{E1 mod E2} & \textit{eval}(\texttt{E1}) - ($\lfloor$\textit{eval}(\texttt{E1}) / \textit{eval}(\texttt{E2})$\rfloor$ * \textit{eval}(\texttt{E2})) & I, I $\rightarrow$ I & Y \\ \hline \texttt{E1 /{\bs} E2} & \textit{eval}(\texttt{E1}) bitwise\_and \textit{eval}(\texttt{E2}) & I, I $\rightarrow$ I & Y \\ \hline \texttt{E1 {\bs}/ E2} & \textit{eval}(\texttt{E1}) bitwise\_or \textit{eval}(\texttt{E2}) & I, I $\rightarrow$ I & Y \\ \hline \texttt{xor(E1,E2)} & \textit{eval}(\texttt{E1}) bitwise\_xor \textit{eval}(\texttt{E2}) & I, I $\rightarrow$ I & Y \\ \hline \texttt{{\bs} E} & bitwise\_not \textit{eval}(\texttt{E}) & I $\rightarrow$ I & Y \\ \hline \texttt{E1 {\lt}{\lt} E2} & \textit{eval}(\texttt{E1}) integer\_shift\_left \textit{eval}(\texttt{E2}) & I, I $\rightarrow$ I & Y \\ \hline \texttt{E1 {\gt}{\gt} E2} & \textit{eval}(\texttt{E1}) integer\_shift\_right \textit{eval}(\texttt{E2}) & I, I $\rightarrow$ I & Y \\ \hline \texttt{lsb(E)} & least significant bit (from 0) of \textit{eval}(\texttt{E}) or -1 & I $\rightarrow$ I & N \\ \hline \texttt{msb(E)} & most significant bit (from 0) of \textit{eval}(\texttt{E}) or -1 & I $\rightarrow$ I & N \\ \hline \texttt{popcount(E)} & number of 1-bits in \textit{eval}(\texttt{E}) & I $\rightarrow$ I & N \\ \hline \texttt{abs(E)} & absolute value of \textit{eval}(\texttt{E}) & IF $\rightarrow$ IF & Y \\ \hline \texttt{sign(E)} & sign of \textit{eval}(\texttt{E}) (-1 if $<$ 0, 0 if = 0, +1 if $>$ 0) & IF $\rightarrow$ IF & Y \\ \hline \texttt{min(E1,E2)} & minimal value between \textit{eval}(\texttt{E1}) and \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ ? & Y \\ \hline \texttt{max(E1,E2)} & maximal value between \textit{eval}(\texttt{E1}) and \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ ? & Y \\ \hline \texttt{gcd(E1,E2)} & greatest common divisor of \textit{eval}(\texttt{E1}) and \textit{eval}(\texttt{E2}) & I, I $\rightarrow$ I & N \\ \hline \texttt{E1 \^{} E2} & \textit{eval}(\texttt{E1}) raised to the power of \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ IF & Y \\ \hline \texttt{E1 ** E2} & \textit{eval}(\texttt{E1}) raised to the power of \textit{eval}(\texttt{E2}) & IF, IF $\rightarrow$ F & Y \\ \hline \texttt{sqrt(E)} & square root of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{tan(E)} & tangent of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{atan(E)} & arc tangent of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{atan2(Y,X)} & principal value of arc tangent of \textit{eval}(\texttt{Y}) / \textit{eval}(\texttt{X}) using both signs for the quadrant & IF $\rightarrow$ F & Y \\ \hline \texttt{cos(E)} & cosine of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{acos(E)} & arc cosine of \textit{eval}(\texttt{E}) & IF, IF $\rightarrow$ F & Y \\ \hline \texttt{sin(E)} & sine of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{asin(E)} & arc sine of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{tanh(E)} & hyperbolic tangent of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & N \\ \hline \texttt{atanh(E)} & hyperbolic arc tangent of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & N \\ \hline \texttt{cosh(E)} & hyperbolic cosine of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & N \\ \hline \texttt{acosh(E)} & hyperbolic arc cosine of \textit{eval}(\texttt{E}) & IF, IF $\rightarrow$ F & N \\ \hline \texttt{sinh(E)} & hyperbolic sine of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & N \\ \hline \texttt{asinh(E)} & hyperbolic arc sine of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & N \\ \hline \texttt{exp(E)} & $e$ raised to the power of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{log(E)} & natural logarithm of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{log10(E)} & base 10 logarithm of \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & N \\ \hline \texttt{log(R, E)} & base \textit{eval}(\texttt{R}) logarithm of \textit{eval}(\texttt{E}) & F, IF $\rightarrow$ F & N \\ \hline \texttt{float(E)} & the floating point number equal to \textit{eval}(\texttt{E}) & IF $\rightarrow$ F & Y \\ \hline \texttt{ceiling(E)} & rounds \textit{eval}(\texttt{E}) upward to the nearest integer & F $\rightarrow$ I & Y \\ \hline \texttt{floor(E)} & rounds \textit{eval}(\texttt{E}) downward to the nearest integer & F $\rightarrow$ I & Y \\ \hline \texttt{round(E)} & rounds \textit{eval}(\texttt{E}) to the nearest integer & F $\rightarrow$ I & Y \\ \hline \texttt{truncate(E)} & the integer value of \textit{eval}(\texttt{E}) & F $\rightarrow$ I & Y \\ \hline \texttt{float\_fractional\_part(E)} & the float equal to the fractional part of \textit{eval}(\texttt{E}) & F $\rightarrow$ F & Y \\ \hline \texttt{float\_integer\_part(E)} & the float equal to the integer part of \textit{eval}(\texttt{E}) & F $\rightarrow$ F & Y \\ \hline \end{supertabular} The meaning of the signature field is as follows: \begin{itemize} \item I $\rightarrow$ I: unary function, the operand must be an integer and the result is an integer. \item F $\rightarrow$ F: unary function, the operand must be a floating point number and the result is a floating point number. \item F $\rightarrow$ I: unary function, the operand must be a floating point number and the result is an integer. \item IF $\rightarrow$ F: unary function, the operand can be an integer or a floating point number and the result is a floating point number. \item IF $\rightarrow$ IF: unary function, the operand can be an integer or a floating point number and the result has the same type as the operand. \item I, I $\rightarrow$ I: binary function: each operand must be an integer and the result is an integer. \item IF, IF $\rightarrow$ IF: binary function: each operand can be an integer or a floating point number and the result is a floating point number if at least one operand is a floating point number, an integer otherwise. \item IF, IF $\rightarrow$ ?: binary function: each operand can be an integer or a floating point number and the result has the same type as the selected operand. This is used for \texttt{min} and \texttt{max}. Note that in case of equality between an integer and a floating point number the result is an integer. \end{itemize} \texttt{is}, \texttt{+}, \texttt{-}, \texttt{*}, \texttt{/}, \texttt{//}, \texttt{div}, \texttt{rem}, \texttt{mod}, \texttt{/{\bs}}, \texttt{{\bs}/}, \texttt{{\lt}{\lt}}, \texttt{{\gt}{\gt}}, \texttt{**} and \texttt{\^{}} are predefined infix operators. \texttt{+}, \texttt{-} and \texttt{{\bs}}, are predefined prefix operators \RefSP{op/3:(Term-input/output)}. \SPart{Integer division rounding function}: the integer division rounding function \texttt{\textit{rnd}(X)} rounds the floating point number \texttt{X} to an integer. There are two possible definitions (depending on the target machine) for this function which differ on negative numbers: \begin{itemize} \item \texttt{\textit{rnd}(X)} = integer part of \texttt{X}, e.g. \texttt{\textit{rnd}(-1.5)} = \texttt{-1} (round toward 0) \item \texttt{\textit{rnd}(X)} = $\lfloor$\texttt{X}$\rfloor$, e.g. \texttt{\textit{rnd}(-1.5)} = \texttt{-2} (round toward $-\infty$) \end{itemize} The definition of this function determines the definition of the integer division and remainder (\texttt{(//)/2} and \texttt{(rem)/2}). It is possible to test the value (\texttt{toward\_zero} or \texttt{down}) of the \IdxPF{integer\_rounding\_function} \Idx{Prolog flag} to determine which function being used \RefSP{set-prolog-flag/2}. Since rounding toward zero is the most common case, two additional evaluable functors (\texttt{(div)/2} and \texttt{(mod)/2}) are available which consider rounding toward $-\infty$. \SPart{Fast mathematical mode}: in order to speed-up integer computations, the GNU Prolog compiler can generate faster code when invoked with the \IdxK{--fast-math} option \RefSP{Using-the-compiler}. In this mode only integer operations are allowed and a variable in an expression must be bound at evaluation time to an integer. No type checking is done. \begin{PlErrors} \ErrCond{a sub-expression \texttt{E} is a variable} \ErrTerm{instantiation\_error} \ErrCond{a sub-expression \texttt{E} is neither a number nor an evaluable functor} \ErrTerm{type\_error(evaluable, E)} \ErrCond{a sub-expression \texttt{E} is a floating point number while an integer is expected} \ErrTerm{type\_error(integer, E)} \ErrCond{a sub-expression \texttt{E} is an integer while a floating point number is expected} \ErrTerm{type\_error(float, E)} \ErrCond{a division by zero occurs} \ErrTerm{evaluation\_error(zero\_divisor)} \end{PlErrors} \Portability Refer to the above table to determine which evaluable functors are ISO and which are GNU Prolog extensions. For efficiency reasons, GNU Prolog does not detect the following ISO arithmetic errors: \texttt{float\_overflow}, \texttt{int\_overflow, int\_underflow}, and \texttt{undefined}. \subsubsection{\IdxPBD{(is)/2} - evaluate expression} \begin{TemplatesOneCol} is(?term, +evaluable) \end{TemplatesOneCol} \Description \texttt{Result is Expression} succeeds if \texttt{Result} can be unified with \textit{eval}(\texttt{Expression}). Refer to the evaluation of an arithmetic expression for the definition of the \textit{eval} function \RefSP{Evaluation-of-an-arithmetic-expression}. \texttt{is} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. \Errors Refer to the evaluation of an arithmetic expression for possible errors \RefSP{Evaluation-of-an-arithmetic-expression}. \Portability ISO predicate. \subsubsection{\IdxPBD{(=:=)/2} - arithmetic equal, \label{(=:=)/2} \IdxPBD{(={\bs}=)/2} - arithmetic not equal, \\ \IdxPBD{({\lt})/2} - arithmetic less than, \IdxPBD{(={\lt})/2} - arithmetic less than or equal to, \\ \IdxPBD{({\gt})/2} - arithmetic greater than, \IdxPBD{({\gt}=)/2} - arithmetic greater than or equal to} \begin{TemplatesTwoCols} =:=(+evaluable, +evaluable)\\ ={\bs}=(+evaluable, +evaluable)\\ {\lt}(+evaluable, +evaluable)\\ ={\lt}(+evaluable, +evaluable)\\ {\gt}(+evaluable, +evaluable)\\ {\gt}=(+evaluable, +evaluable) \end{TemplatesTwoCols} \Description \texttt{Expr1 =:= Expr2} succeeds if \textit{eval}(\texttt{Expr1}) = \textit{eval}(\texttt{Expr2}). \texttt{Expr1 ={\bs}= Expr2} succeeds if \textit{eval}(\texttt{Expr1}) $\neq$ \textit{eval}(\texttt{Expr2}). \texttt{Expr1 {\lt} Expr2} succeeds if \textit{eval}(\texttt{Expr1}) $<$ \textit{eval}(\texttt{Expr2}). \texttt{Expr1 ={\lt} Expr2} succeeds if \textit{eval}(\texttt{Expr1}) $\leq$ \textit{eval}(\texttt{Expr2}). \texttt{Expr1 {\gt} Expr2} succeeds if \textit{eval}(\texttt{Expr1}) $>$ \textit{eval}(\texttt{Expr2}). \texttt{Expr1 {\gt}= Expr2} succeeds if \textit{eval}(\texttt{Expr1}) $\geq$ \textit{eval}(\texttt{Expr2}). Refer to the evaluation of an arithmetic expression for the definition of the \textit{eval} function \RefSP{Evaluation-of-an-arithmetic-expression}. \texttt{=:=}, \texttt{={\bs}=}, \texttt{{\lt}}, \texttt{={\lt}}, \texttt{{\gt}} and \texttt{{\gt}=} are predefined infix operators \RefSP{op/3:(Term-input/output)}. \Errors Refer to the evaluation of an arithmetic expression for possible errors \RefSP{Evaluation-of-an-arithmetic-expression}. \Portability ISO predicates. \subsubsection{\IdxPBD{succ/2}} \begin{TemplatesOneCol} succ(+integer, ?integer) \\ succ(-integer, +integer) \end{TemplatesOneCol} \Description \texttt{succ(X, Y)} is true iff \texttt{Y} is the successor of the non-negative integer \texttt{X}. \begin{PlErrors} \ErrCond{\texttt{X} and \texttt{Y} are both variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{X} is neither a variable nor an integer} \ErrTerm{type\_error(integer, X)} \ErrCond{\texttt{Y} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Y)} \ErrCond{\texttt{X} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, X)} \ErrCond{\texttt{Y} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Y)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Dynamic clause management} \subsubsection{Introduction} \label{Introduction:(Dynamic-clause-management)} \SPart{Static and dynamic procedures}: a procedure is either dynamic or static. All built-in predicates are static. A user-defined procedure is static by default unless a \IdxDi{dynamic/1} directive precedes its definition \RefSP{dynamic/1}. Adding a clause to a non-existent procedure creates a dynamic procedure. The clauses of a dynamic procedure can be altered (e.g. using \texttt{asserta/1}), the clauses of a static procedure cannot be altered. \SPart{Private and public procedures}: each procedure is either public or private. A dynamic procedure is always public. Each built-in predicate is private, and a static user-defined procedure is private by default unless a \IdxDi{public/1} directive precedes its definition \RefSP{public/1}. If a dynamic declaration exists it is unnecessary to add a public declaration since a dynamic procedure is also public. A clause of a public procedure can be inspected (e.g. using \texttt{clause/2}), a clause of a private procedure cannot be inspected. \SPart{A logical database update view}: any change in the database that occurs as the result of executing a goal (e.g. when a sub-goal is a call of \texttt{assertz/1} or \texttt{retract/1}) only affects subsequent activations. The change does not affect any activation that is currently being executed. Thus the database is frozen during the execution of a goal, and the list of clauses defining a predication is fixed at the moment of its execution. \subsubsection{\IdxPBD{asserta/1}, \IdxPBD{assertz/1}} \begin{TemplatesOneCol} asserta(+clause)\\ assertz(+clause) \end{TemplatesOneCol} \Description \texttt{asserta(Clause)} first converts the term \texttt{Clause} to a clause and then adds it to the current internal database. The predicate concerned must be dynamic \RefSP{Introduction:(Dynamic-clause-management)} or undefined and the clause is inserted before the first clause of the predicate. If the predicated is undefined it is created as a dynamic procedure. \texttt{assertz(Clause)} acts like \texttt{asserta/1} except that the clause is added at the end of all existing clauses of the concerned predicate. \SPart{Converting a term \texttt{Clause} to a clause \texttt{Clause1}:} \begin{itemize} \item extract the head and the body of \texttt{Clause}: either \texttt{Clause} = \texttt{(Head :- Body)} or \texttt{Clause} = \texttt{Head} and \texttt{Body} = \texttt{true}. \item \texttt{Head} must be a callable term (or else the conversion fails). \item convert \texttt{Body} to a body clause (i.e. a goal) \texttt{Body1}. \item the converted clause \texttt{Clause1} = \texttt{(Head :- Body1)}. \end{itemize} \SPart{Converting a term \texttt{T} to a goal:} \begin{itemize} \item if \texttt{T} is a variable it is replaced by the term \texttt{call(T)}. \item if \texttt{T} is a control construct \texttt{(',')/2}, \texttt{(;)/2} or \texttt{(-{\gt})/2} each argument of the control construct is recursively converted to a goal. \item if \texttt{T} is a callable term it remains unchanged. \item otherwise the conversion fails (\texttt{T} is neither a variable nor a callable term). \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Head} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Head} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Head)} \ErrCond{\texttt{Body} cannot be converted to a goal} \ErrTerm{type\_error(callable, Body)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Head} is that of a static procedure} \ErrTerm{permission\_error(modify, static\_procedure, Pred)} \end{PlErrors} \Portability ISO predicates. \subsubsection{\IdxPBD{retract/1}} \begin{TemplatesOneCol} retract(+clause) \end{TemplatesOneCol} \Description \texttt{retract(Clause)} erases the first clause of the database that unifies with \texttt{Clause}. The concerned predicate must be a dynamic procedure \RefSP{Introduction:(Dynamic-clause-management)}. Removing all clauses of a procedure does not erase the procedure definition. To achieve this use \texttt{abolish/1} \RefSP{abolish/1}. \texttt{retract/1} is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Head} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Head} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Head)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Head} is that of a static procedure} \ErrTerm{permission\_error(modify, static\_procedure, Pred)} \end{PlErrors} \Portability ISO predicate. In the ISO reference, the operation associated with the \texttt{permission\_error} is \texttt{access} while it is \texttt{modify} in GNU Prolog. This seems to be an error of the ISO reference since for \texttt{asserta/1} (which is similar in spirit to \texttt{retract/1}) the operation is also \texttt{modify}. \subsubsection{\IdxPBD{retractall/1}} \begin{TemplatesOneCol} retractall(+head) \end{TemplatesOneCol} \Description \texttt{retractall(Head)} erases all clauses whose head unifies with \texttt{Head}. The concerned predicate must be a dynamic procedure \RefSP{Introduction:(Dynamic-clause-management)}. The procedure definition is not removed so that it is found by \IdxPB{current\_predicate/1} \RefSP{current-predicate/1}. \texttt{abolish/1} should be used to remove the procedure \RefSP{abolish/1}. \begin{PlErrors} \ErrCond{\texttt{Head} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Head} is not a callable term} \ErrTerm{type\_error(callable, Head)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Head} is that of a static procedure} \ErrTerm{permission\_error(modify, static\_procedure, Pred)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{clause/2}} \begin{TemplatesOneCol} clause(+head, ?callable\_term) \end{TemplatesOneCol} \Description \texttt{clause(Head, Body)} succeeds if there exists a clause in the database that unifies with \texttt{Head :- Body}. The predicate in question must be a public procedure \RefSP{Introduction:(Dynamic-clause-management)}. Clauses are delivered from the first to the last. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Head} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Head} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Head)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Head} is that of a private procedure} \ErrTerm{permission\_error(access, private\_procedure, Pred)} \ErrCond{\texttt{Body} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Body)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{abolish/1}\label{abolish/1}} \begin{TemplatesOneCol} abolish(+predicate\_indicator) \end{TemplatesOneCol} \Description \texttt{abolish(Pred)} removes from the database the procedure whose predicate indicator is \texttt{Pred}. The concerned predicate must be a dynamic procedure \RefSP{Introduction:(Dynamic-clause-management)}. \begin{PlErrors} \ErrCond{\texttt{Pred} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and either \texttt{Name} or \texttt{Arity} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Pred} is neither a variable nor a predicate indicator} \ErrTerm{type\_error(predicate\_indicator, Pred)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Arity} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Arity)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Name} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Name)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Arity} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Arity)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Arity} is an integer $>$ \texttt{max\_arity} flag \RefSP{set-prolog-flag/2}} \ErrTerm{representation\_error(max\_arity)} \ErrCond{The predicate indicator \texttt{Pred} is that of a static procedure} \ErrTerm{permission\_error(modify, static\_procedure, Pred)} \end{PlErrors} \Portability ISO predicate. \subsection{Predicate information} \subsubsection{\IdxPBD{current\_predicate/1}\label{current-predicate/1}} \begin{TemplatesOneCol} current\_predicate(?predicate\_indicator) \end{TemplatesOneCol} \Description \texttt{current\_predicate(Pred)} succeeds if there exists a predicate indicator of a defined procedure that unifies with \texttt{Pred}. All user defined procedures are found, whether static or dynamic. Internal system procedures whose name begins with \texttt{'\$'} are not found. A user-defined procedure is found even when it has no clauses. A user-defined procedure is not found if it has been abolished. To conform to the ISO reference, built-in predicates are not found except if the \IdxPF{strict\_iso} \Idx{Prolog flag} is switched off \RefSP{set-prolog-flag/2}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Pred} is neither a variable nor a predicate indicator} \ErrTerm{type\_error(predicate\_indicator, Pred)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Arity} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Arity)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Name} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Name)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Arity} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Arity)} \ErrCond{\texttt{Pred} is a term \texttt{Name/Arity} and \texttt{Arity} is an integer $>$ \texttt{max\_arity} flag \RefSP{set-prolog-flag/2}} \ErrTerm{representation\_error(max\_arity)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{predicate\_property/2}\label{predicate-property/2}} \begin{TemplatesOneCol} predicate\_property(?callable, ?predicate\_property) \end{TemplatesOneCol} \Description \texttt{predicate\_property(Head, Property)} succeeds if \texttt{Head} refers to a predicate that has a property \texttt{Property}. All user defined procedures and built-in predicates are found. Internal system procedures whose name begins with \texttt{'\$'} are not found. This predicate is re-executable on backtracking. Since version 1.4.0, \texttt{predicate\_property/2} no longer accepts a predicate indicator. Control constructs are now returned. Properties \texttt{built\_in\_fd} and \texttt{control\_construct} now imply the property \texttt{built\_in}. \SPart{Predicate properties}: \begin{itemize} \item \IdxPPD{static}: if the procedure is static. \item \IdxPPD{dynamic}: if the procedure is dynamic. \item \IdxPPD{private}: if the procedure is private. \item \IdxPPD{public}: if the procedure is public. \item \IdxPPD{monofile}: if the procedure is monofile. \item \IdxPPD{multifile}: if the procedure is multifile. \item \IdxPPD{user}: if the procedure is a user-defined procedure. \item \IdxPPD{built\_in}: if the procedure is a built-in predicate or a control construct. \item \IdxPPD{built\_in\_fd}: if the procedure is an FD built-in predicate. \item \IdxPPD{control\_construct}: if the procedure is a control construct \RefSP{control-construct}. \item \IdxPPD{native\_code}: if the procedure is compiled in native code. \item \AddPPD{prolog\_file}\texttt{prolog\_file(File)}: source file from which the procedure has been read. \item \AddPPD{prolog\_line}\texttt{prolog\_line(Line)}: line number of the source file. \item \AddPPD{meta\_predicate}\texttt{meta\_predicate(Head)}: if the procedure is a meta-predicate unify \texttt{Head} with the head-pattern. The head-pattern is a compound term with the same name and arity as the predicate where each argument of the term is a meta argument specifier as follows: \BL \begin{description} \item [integer \texttt{N}] the argument is a term that is used to reference a predicate with \texttt{N} more arguments than the given argument term (e.g. \texttt{call(0)}). \item [\texttt{:}] the argument is module sensitive, but does not directly refer to a predicate (e.g. \texttt{consult(:)}). \item [\texttt{-}] the argument is not module sensitive and unbound on entry. \item [\texttt{?}] the argument is not module sensitive and the mode is unspecified. \item [\texttt{+}] the argument is not module sensitive and bound (i.e., nonvar) on entry. \end{description} \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Head} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Head)} \ErrCond{\texttt{Property} is neither a variable nor a predicate property term} \ErrTerm{domain\_error(predicate\_property, Property)} \ErrCond{\texttt{Property} = \texttt{prolog\_file(File)} and \texttt{File} is neither a variable nor an atom} \ErrTerm{type\_error(atom, File)} \ErrCond{\texttt{Property} = \texttt{prolog\_line(Line)} and \texttt{Line} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Line)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{All solutions} \subsubsection{Introduction} \label{Introduction:(All-solutions)} It is sometimes useful to collect all solutions for a goal. This can be done by repeatedly backtracking and gradually building the list of solutions. The following built-in predicates are provided to automate this process. The built-in predicates described in this section invoke \texttt{call/1} \RefSP{call/1} on the argument \texttt{Goal}. When efficiency is crucial and \texttt{Goal} is complex it is better to define an auxiliary predicate which can then be compiled, and have \texttt{Goal} call this predicate. \subsubsection{\IdxPBD{findall/4}, \IdxPBD{findall/3}} \begin{TemplatesOneCol} findall(?term, +callable\_term, ?list, ?term) findall(?term, +callable\_term, ?list) \end{TemplatesOneCol} \Description \texttt{findall(Template, Goal, Instances)} succeeds if \texttt{Instances} unifies with the list of values to which a variable \texttt{X} not occurring in \texttt{Template} or \texttt{Goal} would be instantiated by successive re-executions of \texttt{call(Goal), X = Template} after systematic replacement of all variables in \texttt{X} by new variables. Thus, the order of the list \texttt{Instances} corresponds to the order in which the proofs are found. \texttt{findall(Template, Goal, Instances, Tail)} is the difference list version of \texttt{findall/3}. The result is the difference list \texttt{Instances}-\texttt{Tail}. Thus \texttt{findall(Template, Goal, Instances)} is equivalent to \texttt{findall(Template, Goal, Instances, [])}. \begin{PlErrors} \ErrCond{\texttt{Goal} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Goal} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Goal} does not correspond to an existing procedure and the value of the \texttt{unknown} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{existence\_error(procedure, Pred)} \ErrCond{\texttt{Instances} is neither a partial list nor a list} \ErrTerm{type\_error(list, Instances)} \end{PlErrors} \Portability \texttt{findall/3} is an ISO predicate. \texttt{findall/4} is a GNU Prolog predicate. \subsubsection{\IdxPBD{bagof/3}, \IdxPBD{setof/3}} \begin{TemplatesOneCol} bagof(?term, +callable\_term, ?list)\\ setof(?term, +callable\_term, ?list) \end{TemplatesOneCol} \Description \texttt{bagof(Template, Goal, Instances)} assembles as a list the set of solutions of \texttt{Goal} for each different instantiation of the free variables in \texttt{Goal}. The elements of each list are in order of solution, but the order in which each list is found is undefined. This predicate is re-executable on backtracking. \SPart{Free variable set}: \texttt{bagof/3} groups the solutions of \texttt{Goal} according to the free variables in \texttt{Goal}. This set corresponds to all variables occurring in \texttt{Goal} but not in \texttt{Template}. It is sometimes useful to exclude some additional variables of \texttt{Goal}. For that, \texttt{bagof/3} recognizes a goal of the form \texttt{T\^{}Goal} and exclude all variables occurring in \texttt{T} from the free variable set. \texttt{(\^{})/2} can be viewed as an \emph{existential quantifier} (the logical reading of \texttt{X\^{}Goal} being ``there exists an \texttt{X} such that \texttt{Goal} is true''). The use of this existential qualifier is superfluous outside \texttt{bagof/3} (and \texttt{setof/3}) and then is not recognized. \texttt{(\^{})/2} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. \texttt{setof(Template, Goal, Instances)} is equivalent to \texttt{bagof(Template,Goal,I), sort(I,Instances)}. Each list is then a sorted list (duplicate elements are removed). From the implementation point of view \texttt{setof/3} is as fast as \texttt{bagof/3}. Both predicates use an in-place (i.e. destructive) sort \RefSP{sort/2} and require the same amount of memory. \begin{PlErrors} \ErrCond{\texttt{Goal} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Goal} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Goal} does not correspond to an existing procedure and the value of the \texttt{unknown} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{existence\_error(procedure, Pred)} \ErrCond{\texttt{Instances} is neither a partial list nor a list} \ErrTerm{type\_error(list, Instances)} \end{PlErrors} \Portability ISO predicates. \subsection{Streams} \label{Streams} \subsubsection{Introduction} \label{Introduction:(Streams)} A stream provides a logical view of a source/sink. \SPart{Sources and sinks}: a program can output results to a sink or input data from a source. A source/sink may be a file (regular file, terminal, device,\ldots), a constant term, a pipe, a socket,\ldots \SPart{Associating a stream to a source/sink}: to manipulate a source/sink it must be associated with a stream. This provides a logical and uniform view of the source/sink whatever its type. Once this association has been established, i.e. a stream has been created, all subsequent references to the source/sink are made by referring the stream. A stream is unidirectional: it is either an input stream or an output stream. For a classical file, the association is done by opening the file (whose name is specified as an atom) with the \IdxPB{open/4} \RefSP{open/4}. GNU Prolog makes it possible to treat a Prolog constant term as a source/sink and provides built-in predicates to associate a stream to such a term \RefSP{Constant-term-streams}. GNU Prolog provides operating system interface predicates defining pipes between GNU Prolog and child processes with streams associated with these pipes, e.g. \IdxPB{popen/3} \RefSP{popen/3}. Similarly, socket interface predicates associate streams to a socket to allow the communication, e.g. \IdxPB{socket\_connect/4} \RefSP{socket-connect/4}. \SPart{Stream-term}: a stream-term identifies a stream during a call of an input/output built-in predicate. It is created as a result of associating a stream to a source/sink (section above). A stream-term is a compound term of the form \texttt{'\$stream'(I)} where \texttt{I} is an integer. \SPart{Stream aliases}: any stream may be associated with a stream alias which is an atom which may be used to refer to that stream. The association can be done at open time or using \IdxPB{add\_stream\_alias/2} \RefSP{add-stream-alias/2}. Such an association automatically ends when the stream is closed. A particular alias only refers to at most one stream at any one time. However, more than one alias can be associated with a stream. Most built-in predicates which have a stream-term as an input argument also accept a stream alias as that argument. However, built-in predicates which return a stream-term do not accept a stream alias. \SPart{Standard streams}: three streams are predefined and open during the execution of every goal: the standard input stream which has the alias \IdxPKD{user\_input}, the standard output stream which has the alias \IdxPKD{user\_output} and the standard error stream which has the alias \IdxPKD{user\_error}. A goal which attempts to close either standard stream succeeds, but does not close the stream. \SPart{Current streams}: during execution there is a current input stream and a current output stream. By default, the current input and output streams are the standard input and output streams, but the built-in predicates \IdxPB{set\_input/1} \RefSP{set-input/1} and \IdxPB{set\_output/1} \RefSP{set-output/1} can be used to change them. When the current input stream is closed, the standard input stream becomes the current input stream. When the current output stream is closed, the standard output stream becomes the current output stream. \SPart{Text streams and binary streams}: a text stream is a sequence of characters. A text stream is also regarded as a sequence of lines where each line is a possibly empty sequence of characters followed by a new line character. GNU Prolog may add or remove space characters at the ends of lines in order to conform to the conventions for representing text streams in the operating system. A binary stream is a sequence of bytes. Only a few built-in predicates can deal with binary streams, e.g. \IdxPB{get\_byte/2} \RefSP{Byte-input/output}. \SPart{Stream positions}: the stream position of a stream identifies an absolute position of the source/sink to which the stream is connected and defines where in the source/sink the next input or output will take place. A stream position is a ground term of the form \texttt{'\$stream\_position'(I1, I2, I3, I4)} where \texttt{I1}, \texttt{I2}, \texttt{I3} and \texttt{I4} are integers. Stream positions are used to reposition a stream (when possible) using for instance \IdxPB{set\_stream\_position/2} \RefSP{set-stream-position/2}. \SPart{The position end of stream}: when all data of a stream \Param{S} has been input \Param{S} has a stream position end-of-stream. At this stream position a goal to input more data will return a specific value to indicate that end of stream has been reached (e.g. \texttt{-1} for \texttt{get\_code/2} or \texttt{end\_of\_file} for \texttt{get\_char/2},\ldots). When this terminating value has been input, the stream has a stream position past-end-of-stream. \SPart{Buffering mode}: input/output on a stream can be buffered (line-buffered or block-buffered) or not buffered at all. The buffering mode can be specified at open time or using \IdxPB{set\_stream\_buffering/2} \RefSP{set-stream-buffering/2}. Line buffering is used on output streams, output data are only written to the sink when a new-line character is output (or at the close time). Block buffering is used on input or output. On input streams, when an input is requested on the source, if the buffer is empty, all available characters are read (within the limits of the size of the buffer), subsequent reads will first use the characters in the buffer. On output streams, output data are stored in the buffer and only when the buffer is full is it physically written on the sink. Thus, an output to a buffered stream may not be sent immediately to the sink connected to that stream. When it is necessary to be certain that output has been delivered, the built-in predicate \IdxPB{flush\_output/1} \RefSP{flush-output/1} should be used. Finally, it is also possible to use non-buffered streams, in that case input/output are directly done on the connected source/sink. This can be useful for communication purposes (e.g. sockets) or when a precise control is needed, e.g. \IdxPB{select/5} \RefSP{wait/2}. \SPart{Stream mirrors}: any stream may be associated with mirror streams specified at open time or using \IdxPB{add\_stream\_mirror/2} \RefSP{add-stream-mirror/2}. Then, all characters/bytes read from/written to the stream are also written on each mirror stream. The association automatically ends when either the stream or the mirror stream is closed. It is also possible to explicitly remove a mirror stream using \IdxPB{remove\_stream\_mirror/2} \RefSP{remove-stream-mirror/2}. \subsubsection{\IdxPBD{current\_input/1}} \begin{TemplatesOneCol} current\_input(?stream) \end{TemplatesOneCol} \Description \texttt{current\_input(Stream)} unifies \texttt{Stream} with the stream-term identifying the current input stream. \begin{PlErrors} \ErrCond{\texttt{Stream} is neither a variable nor a stream} \ErrTerm{domain\_error(stream, Stream)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{current\_output/1}} \begin{TemplatesOneCol} current\_output(?stream) \end{TemplatesOneCol} \Description \texttt{current\_output(Stream)} unifies \texttt{Stream} with the stream-term identifying the current output stream. \begin{PlErrors} \ErrCond{\texttt{Stream} is neither a variable nor a stream} \ErrTerm{domain\_error(stream, Stream)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{set\_input/1}\label{set-input/1}} \begin{TemplatesOneCol} set\_input(+stream\_or\_alias) \end{TemplatesOneCol} \Description \texttt{set\_input(SorA)} sets the current input stream to be the stream associated with the stream-term or alias \texttt{SorA}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{set\_output/1}\label{set-output/1}} \begin{TemplatesOneCol} set\_output(+stream\_or\_alias) \end{TemplatesOneCol} \Description \texttt{set\_output(SorA)} sets the current output stream to be the stream associated with the stream-term or alias \texttt{SorA}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(output, stream, SorA)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{open/4},\label{open/4} \IdxPBD{open/3}} \begin{TemplatesOneCol} open(+source\_sink, +io\_mode, -stream, +stream\_option\_list)\\ open(+source\_sink, +io\_mode, -stream) \end{TemplatesOneCol} \Description \texttt{open(SourceSink, Mode, Stream, Options)} opens the source/sink \texttt{SourceSink} for input or output as indicated by \texttt{Mode} and the list of stream-options \texttt{Options} and unifies \texttt{Stream} with the stream-term which is associated with this stream. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{SourceSink} \RefSP{absolute-file-name/2}. \SPart{Input/output modes}: \texttt{Mode} is an atom which defines the input/output operations that may be performed the stream. Possible modes are: \begin{itemize} \item \IdxPMD{read}: the source/sink is a source and must already exist. Input starts at the beginning of the source. \item \IdxPMD{write}: the source/sink is a sink. If the sink already exists then it is emptied else an empty sink is created. Output starts at the beginning of that sink. \item \IdxPMD{append}: the source/sink is a sink. If the sink does not exist it is created. Output starts at the end of that sink. \end{itemize} \SPart{Stream options}: \texttt{Options} is a list of stream options. If this list contains contradictory options, the rightmost option is the one which applies. Possible options are: \begin{itemize} \item \AddPOD{type}\texttt{type(}\IdxPOD{text}/\IdxPOD{binary}\texttt{)}: specifies whether the stream is a text stream or a binary stream. The default value is \texttt{text}. \item \AddPOD{reposition}\texttt{reposition(true}/\texttt{false)}: specifies whether it is possible to reposition the stream. The default value is \texttt{true} except if the stream cannot be repositioned (e.g. a terminal). \item \AddPOD{eof\_action}\texttt{eof\_action(error}/\texttt{eof\_code}/\texttt{reset)}: specifies the effect of attempting to input from a stream whose stream position is past-end-of-stream: \begin{itemize} \item \IdxPOD{error}: a \texttt{permission\_error} is raised signifying that no more input exists in this stream. \item \IdxPOD{eof\_code}: the result of input is as if the stream position is end-of-stream. \item \IdxPOD{reset}: the stream position is reset so that it is not past-end-of-stream, and another attempt is made to input from it (this is useful when inputting from a terminal). \end{itemize} The default value is \texttt{eof\_code}. \item \AddPOD{alias}\texttt{alias(Alias)}: specifies that the atom \texttt{Alias} is to be an alias for the stream. By default no alias is attached to the stream. Several aliases can be defined for a same stream. \item \AddPOD{mirror}\texttt{mirror(Mirror)}: specifies the stream associated with the stream-term or alias \texttt{Mirror} is a mirror for the stream. By default no mirror is attached to the stream. Several mirrors can be defined for a same stream. \item \AddPOD{buffering}\texttt{buffering(none}/\texttt{line}/\texttt{block)}: specifies which type of buffering is used by input/output operations on this stream: \begin{itemize} \item \IdxPOD{none}: no buffering. \item \IdxPOD{line}: output operations buffer data emitted until a new-line occurs \item \IdxPOD{block}: input/output operations buffer data until a given number (implementation dependant) of characters/bytes have been treated. \end{itemize} The default value is \texttt{line} for a terminal (TTY), \texttt{block} otherwise. \end{itemize} \texttt{open(SourceSink, Mode, Stream)} is equivalent to \texttt{open(SourceSink, Mode, Stream, [])}. \begin{PlErrors} \ErrCond{\texttt{SourceSink} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Mode} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Mode} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Mode)} \ErrCond{\texttt{Options} is neither a partial list nor a list} \ErrTerm{type\_error(list, Options)} \ErrCond{\texttt{Stream} is not a variable} \ErrTerm{uninstantiation\_error(Stream)} \ErrCond{\texttt{SourceSink} is neither a variable nor a source/sink} \ErrTerm{domain\_error(source\_sink, SourceSink)} \ErrCond{\texttt{Mode} is an atom but not an input/output mode} \ErrTerm{domain\_error(io\_mode, Mode)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is neither a variable nor a stream-option} \ErrTerm{domain\_error(stream\_option, E)} \ErrCond{the source/sink specified by \texttt{SourceSink} does not exist} \ErrTerm{existence\_error(source\_sink, SourceSink)} \ErrCond{the source/sink specified by \texttt{SourceSink} cannot be opened} \ErrTerm{permission\_error(open, source\_sink, SourceSink)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is \texttt{alias(A)} and \texttt{A} is already associated with an open stream} \ErrTerm{permission\_error(open, source\_sink, alias(A))} \ErrCond{an element \texttt{E} of the \texttt{Options} list is \texttt{mirror(M)} and \texttt{M} is not associated with an open stream} \ErrTerm{existence\_error(stream, M)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is \texttt{mirror(M)} and \texttt{M} is an input stream} \ErrTerm{permission\_error(output, stream, M)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is \texttt{reposition(true)} and it is not possible to reposition this stream} \ErrTerm{permission\_error(open, source\_sink, reposition(true))} \end{PlErrors} \Portability ISO predicates. The \texttt{mirror} and \texttt{buffering} stream options are GNU Prolog extensions. \subsubsection{\IdxPBD{close/2},\label{close/2} \IdxPBD{close/1}} \begin{TemplatesOneCol} close(+stream\_or\_alias, +close\_option\_list)\\ close(+stream\_or\_alias) \end{TemplatesOneCol} \Description \texttt{close(SorA, Options)} closes the stream associated with the stream-term or alias \texttt{SorA}. If \texttt{SorA} is the standard input stream or the standard output stream \texttt{close/2} simply succeeds else the associated source/sink is physically closed. If \texttt{SorA} is the current input stream the current input stream becomes the standard input stream \IdxPK{user\_input}. If \texttt{SorA} is the current output stream the current output stream becomes the standard output stream \IdxPK{user\_output}. \SPart{Close options}: \texttt{Options} is a list of close options. For the moment only one option is available: \begin{itemize} \item \AddPOD{force}\texttt{force(true}/\texttt{false)}: with \texttt{false}, if an error occurs when trying to close the source/sink, the stream is not closed and an error (\texttt{system\_error} or \texttt{resource\_error}) is raised (but \texttt{close/2} succeeds). With \texttt{true}, if an error occurs it is ignored and the stream is closed. The purpose of \texttt{force/1} option is to allow an error handling routine to do its best to reclaim resources. The default value is \texttt{false}. \end{itemize} \texttt{close(SorA)} is equivalent to \texttt{close(SorA, [])}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is neither a partial list nor a list} \ErrTerm{type\_error(list, Options)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is neither a variable nor a close-option} \ErrTerm{domain\_error(close\_option, E)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} needs a special close \RefSP{Constant-term-streams}} \ErrTerm{system\_error(needs\_special\_close)} \end{PlErrors} \Portability ISO predicates. The \texttt{system\_error(needs\_special\_close)} is a GNU Prolog extension. \subsubsection{\IdxPBD{flush\_output/1},\label{flush-output/1} \IdxPBD{flush\_output/0}} \begin{TemplatesOneCol} flush\_output(+stream\_or\_alias)\\ flush\_output \end{TemplatesOneCol} \Description \texttt{flush\_output(SorA)} sends any buffered output characters/bytes to the stream. \texttt{flush\_output/0} applies to the current output stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(output, stream, SorA)} \end{PlErrors} \Portability ISO predicates. \subsubsection{\IdxPBD{current\_stream/1}\label{current-stream/1}} \begin{TemplatesOneCol} current\_stream(?stream) \end{TemplatesOneCol} \Description \texttt{current\_stream(Stream)} succeeds if there exists a stream-term that unifies with \texttt{Stream}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Stream} is neither a variable nor a stream-term} \ErrTerm{domain\_error(stream, Stream)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{stream\_property/2}\label{stream-property/2}} \begin{TemplatesOneCol} stream\_property(?stream, ?stream\_property) \end{TemplatesOneCol} \Description \texttt{stream\_property(Stream, Property)} succeeds if \texttt{current\_stream(Stream)} succeeds \RefSP{current-stream/1} and if \texttt{Property} unifies with one of the properties of the stream. This predicate is re-executable on backtracking. \SPart{Stream properties}: \begin{itemize} \item \AddPPD{file\_name}\texttt{file\_name(F)}: the name of the connected source/sink. \item \AddPPD{mode}\texttt{mode(M)}: \texttt{M} is the open mode (\texttt{read}, \texttt{write}, \texttt{append}). \item \IdxPPD{input}: if it is an input stream. \item \IdxPPD{output}: if it is an output stream. \item \AddPPD{alias}\texttt{alias(A)}: \texttt{A} is an alias of the stream. \item \AddPPD{mirror}\texttt{mirror(M)}: \texttt{M} is a mirror stream of the stream. \item \AddPPD{type}\texttt{type(T)}: \texttt{T} is the type of the stream (\texttt{text}, \texttt{binary}). \item \AddPPD{reposition}\texttt{reposition(R)}: \texttt{R} is the reposition boolean (\texttt{true}, \texttt{false}). \item \AddPPD{eof\_action}\texttt{eof\_action(A)}: \texttt{A} is the end-of-file action (\texttt{error}, \texttt{eof\_code}, \texttt{reset}). \item \AddPPD{buffering}\texttt{buffering(B)}: \texttt{B} is the buffering mode (\texttt{none}, \texttt{line}, \texttt{block}). \item \AddPPD{end\_of\_stream}\texttt{end\_of\_stream(E)}: \texttt{E} is the current end-of-stream status (\texttt{not}, \texttt{at}, \texttt{past}). If the stream position is end-of-stream then \texttt{E} is unified with \texttt{at} else if the stream position is past-end-of-stream then \texttt{E} is unified with \texttt{past} else \texttt{E} is unified with \texttt{not}. \item \AddPPD{position}\texttt{position(P)}: \texttt{P} is the stream-position term associated with the current position. \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Stream} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Stream} is neither a variable nor a stream-term} \ErrTerm{domain\_error(stream, Stream)} \ErrCond{\texttt{Property} is neither a variable nor a stream property} \ErrTerm{domain\_error(stream\_property, Property)} \ErrCond{\texttt{Property} = \texttt{file\_name(E)},\texttt{ mode(E)}, \texttt{alias(E)}, \texttt{end\_of\_stream(E)}, \texttt{eof\_action(E)}, \texttt{reposition(E)}, \texttt{type(E)} or \texttt{buffering(E)} and \texttt{E} is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \end{PlErrors} \Portability ISO predicate. The \texttt{buffering/1} property is a GNU Prolog extension. \subsubsection{\IdxPBD{at\_end\_of\_stream/1}, \IdxPBD{at\_end\_of\_stream/0}} \begin{TemplatesOneCol} at\_end\_of\_stream(+stream\_or\_alias)\\ at\_end\_of\_stream \end{TemplatesOneCol} \Description \texttt{at\_end\_of\_stream(SorA)} succeeds if the stream associated with stream-term or alias \texttt{SorA} has a stream position end-of-stream or past-end-of-stream. This predicate can be defined using \IdxPB{stream\_property/2} \RefSP{stream-property/2}. \texttt{at\_end\_of\_stream/0} applies to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \end{PlErrors} \Portability ISO predicates. The \texttt{permission\_error(input, stream, SorA)} is a GNU Prolog extension. \subsubsection{\IdxPBD{stream\_position/2}\label{stream-position/2}} \begin{TemplatesOneCol} stream\_position(+stream\_or\_alias, ?stream\_position) \end{TemplatesOneCol} \Description \texttt{stream\_position(SorA, Position)} succeeds unifying \texttt{Position} with the stream-position term associated with the current position of the stream-term or alias \texttt{SorA}. This predicate can be defined using \IdxPB{stream\_property/2} \RefSP{stream-property/2}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{Position} is neither a variable nor a stream-position term} \ErrTerm{domain\_error(stream\_position, Position)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{set\_stream\_position/2}\label{set-stream-position/2}} \begin{TemplatesOneCol} set\_stream\_position(+stream\_or\_alias, +stream\_position) \end{TemplatesOneCol} \Description \texttt{set\_stream\_position(SorA, Position)} sets the position of the stream associated with the stream-term or alias \texttt{SorA} to \texttt{Position}. \texttt{Position} should have previously been returned by \IdxPB{stream\_property/2} \RefSP{stream-property/2} or by \IdxPB{stream\_position/2} \RefSP{stream-position/2}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Position} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{Position} is neither a variable nor a stream-position term} \ErrTerm{domain\_error(stream\_position, Position)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} has stream property \texttt{reposition(false)}} \ErrTerm{permission\_error(reposition, stream, SorA)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{seek/4}} \begin{TemplatesOneCol} seek(+stream\_or\_alias, +stream\_seek\_method, +integer, ?integer) \end{TemplatesOneCol} \Description \texttt{seek(SorA, Whence, Offset, NewOffset)} sets the position of the stream associated with the stream-term or alias \texttt{SorA} to \texttt{Offset} according to \texttt{Whence} and unifies \texttt{NewOffset} with the new offset from the beginning of the file. \texttt{seek/4} can only be used on binary streams. \texttt{Whence} is an atom from: \begin{itemize} \item \IdxPWD{bof}: the position is set relatively to the begin of the file (\texttt{Offset} should be $\geq$ 0). \item \IdxPWD{current}: the position is set relatively to the current position (\texttt{Offset} can be $\geq$ 0 or $\leq$ 0). \item \IdxPWD{eof}: the position is set relatively to the end of the file (\texttt{Offset} should be $\leq$ 0). \end{itemize} This predicate is an interface to the C Unix function \texttt{lseek(2)}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Whence} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Offset} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{Whence} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Whence)} \ErrCond{\texttt{Whence} is an atom but not a valid stream seek method} \ErrTerm{domain\_error(stream\_seek\_method, Whence)} \ErrCond{\texttt{Offset} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Offset)} \ErrCond{\texttt{NewOffset} is neither a variable nor an integer} \ErrTerm{type\_error(integer, NewOffset)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} has stream property \texttt{reposition(false)}} \ErrTerm{permission\_error(reposition, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a text stream} \ErrTerm{permission\_error(reposition, text\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{character\_count/2}} \begin{TemplatesOneCol} character\_count(+stream\_or\_alias, ?integer) \end{TemplatesOneCol} \Description \texttt{character\_count(SorA, Count)} unifies \texttt{Count} with the number of characters/bytes read/written on the stream associated with stream-term or alias \texttt{SorA}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Count} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Count)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{line\_count/2}\label{line-count/2}} \begin{TemplatesOneCol} line\_count(+stream\_or\_alias, ?integer) \end{TemplatesOneCol} \Description \texttt{line\_count(SorA, Count)} unifies \texttt{Count} with the number of lines read/written on the stream associated with the stream-term or alias \texttt{SorA}. This predicate can only be used on text streams. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Count} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Count)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(access, binary\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{line\_position/2}\label{line-position/2}} \begin{TemplatesOneCol} line\_position(+stream\_or\_alias, ?integer) \end{TemplatesOneCol} \Description \texttt{line\_position(SorA, Count)} unifies \texttt{Count} with the number of characters read/written on the current line of the stream associated with the stream-term or alias \texttt{SorA}. This predicate can only be used on text streams. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Count} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Count)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(access, binary\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{stream\_line\_column/3}} \begin{TemplatesOneCol} stream\_line\_column(+stream\_or\_alias, ?integer, ?integer) \end{TemplatesOneCol} \Description \texttt{stream\_line\_column(SorA, Line, Column)} unifies \texttt{Line} (resp. \texttt{Column}) with the current line number (resp. column number) of the stream associated with the stream-term or alias \texttt{SorA}. This predicate can only be used on text streams. Note that \texttt{Line} corresponds to the value returned by \IdxPB{line\_count/2} + 1 \RefSP{line-count/2} and \texttt{Column} to the value returned by \texttt{line\_position/2} + 1 \RefSP{line-position/2}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Line} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Line)} \ErrCond{\texttt{Column} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Column)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(access, binary\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{set\_stream\_line\_column/3}} \begin{TemplatesOneCol} set\_stream\_line\_column(+stream\_or\_alias, +integer, +integer) \end{TemplatesOneCol} \Description \texttt{set\_stream\_line\_column(SorA, Line, Column)} sets the stream position of the stream associated with the stream-term or alias \texttt{SorA} according to the line number \texttt{Line} and the column number \texttt{Column}. This predicate can only be used on text streams. It first repositions the stream to the beginning of the file and then reads character by character until the required position is reached. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Line} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Column} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Line} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Line)} \ErrCond{\texttt{Column} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Column)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(reposition, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream property \texttt{reposition(false)}} \ErrTerm{permission\_error(reposition, stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{add\_stream\_alias/2}\label{add-stream-alias/2}} \begin{TemplatesOneCol} add\_stream\_alias(+stream\_or\_alias, +atom) \end{TemplatesOneCol} \Description \texttt{add\_stream\_alias(SorA, Alias)} adds \texttt{Alias} as a new alias to the stream associated with the stream-term or alias \texttt{SorA}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Alias} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Alias} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Alias)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{Alias} is already associated with an open stream} \ErrTerm{permission\_error(add\_alias, source\_sink, alias(Alias))} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{current\_alias/2}} \begin{TemplatesOneCol} current\_alias(?stream, ?atom) \end{TemplatesOneCol} \Description \texttt{current\_alias(Stream, Alias)} succeeds if \texttt{current\_stream(Stream)} succeeds \RefSP{current-stream/1} and if \texttt{Alias} unifies with one of the aliases of the stream. It can be defined using \IdxPB{stream\_property/2} \RefSP{stream-property/2}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Stream} is neither a variable nor a stream-term} \ErrTerm{domain\_error(stream, Stream)} \ErrCond{\texttt{Alias} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Alias)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{add\_stream\_mirror/2}\label{add-stream-mirror/2}} \begin{TemplatesOneCol} add\_stream\_mirror(+stream\_or\_alias, +stream\_or\_alias) \end{TemplatesOneCol} \Description \texttt{add\_stream\_mirror(SorA, Mirror)} adds the stream associated with the stream-term or alias \texttt{Mirror} as a new mirror to the stream associated with the stream-term or alias \texttt{SorA}. After this, all characters (or bytes) read from (or written to) \texttt{SorA} are also written to \texttt{Mirror}. This mirroring occurs until \texttt{Mirror} is explicitly removed using \IdxPB{remove\_stream\_mirror/2} \RefSP{remove-stream-mirror/2} or implicitly when \texttt{Mirror} is closed. Several mirror streams can be associated with a same stream. If \texttt{Mirror} represents the same stream as \texttt{SorA} or if \texttt{Mirror} is already a mirror for \texttt{SorA}, no mirror is added. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Mirror} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{Mirror} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, Mirror)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{Mirror} is not associated with an open stream} \ErrTerm{existence\_error(stream, Mirror)} \ErrCond{\texttt{Mirror} is an input stream} \ErrTerm{permission\_error(output, stream, Mirror)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{remove\_stream\_mirror/2}\label{remove-stream-mirror/2}} \begin{TemplatesOneCol} remove\_stream\_mirror(+stream\_or\_alias, +stream\_or\_alias) \end{TemplatesOneCol} \Description \texttt{remove\_stream\_mirror(SorA, Mirror)} removes the stream associated with the stream-term or alias \texttt{Mirror} from the list of mirrors of the stream associated with the stream-term or alias \texttt{SorA}. This predicate fails if \texttt{Mirror} is not a mirror stream for \texttt{SorA}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Mirror} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{Mirror} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, Mirror)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{Mirror} is not associated with an open stream} \ErrTerm{existence\_error(stream, Mirror)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{current\_mirror/2}} \begin{TemplatesOneCol} current\_mirror(?stream, ?stream) \end{TemplatesOneCol} \Description \texttt{current\_mirror(Stream, M)} succeeds if \texttt{current\_stream(Stream)} succeeds \RefSP{current-stream/1} and if \texttt{M} unifies with one of the mirrors of the stream. It can be defined using \IdxPB{stream\_property/2} \RefSP{stream-property/2}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Stream} is neither a variable nor a stream-term} \ErrTerm{domain\_error(stream, Stream)} \ErrCond{\texttt{M} is neither a variable nor a stream-term} \ErrTerm{domain\_error(stream, M)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{set\_stream\_type/2}\label{set-stream-type/2}} \begin{TemplatesOneCol} set\_stream\_type(+stream\_or\_alias, +atom) \end{TemplatesOneCol} \Description \texttt{set\_stream\_type(SorA, Type)} updates the type associated with stream-term or alias \texttt{SorA}. The value of \texttt{Type} is an atom in \IdxPO{text} or \IdxPO{binary} as for \IdxPB{open/4} \RefSP{open/4}. The type of a stream can only be changed before any input/output operation is executed. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Type} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Type} is neither a variable nor a valid type} \ErrTerm{domain\_error(stream\_type, Type)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{An I/O operation has already been executed on \texttt{SorA}} \ErrTerm{permission\_error(modify, stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{set\_stream\_eof\_action/2}} \begin{TemplatesOneCol} set\_stream\_eof\_action(+stream\_or\_alias, +atom) \end{TemplatesOneCol} \Description \texttt{set\_stream\_eof\_action(SorA, Action)} updates the \texttt{eof\_action} option associated with the stream-term or alias \texttt{SorA}. The value of \texttt{Action} is one of the atoms \IdxPO{error}, \IdxPO{eof\_code}, \IdxPO{reset} as for \IdxPB{open/4} \RefSP{open/4}. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Action} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Action} is neither a variable nor a valid eof action} \ErrTerm{domain\_error(eof\_action, Action)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(modify, stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{set\_stream\_buffering/2}\label{set-stream-buffering/2}} \begin{TemplatesOneCol} set\_stream\_buffering(+stream\_or\_alias, +atom) \end{TemplatesOneCol} \Description \texttt{set\_stream\_buffering(SorA, Buffering)} updates the buffering mode associated with the stream-term or alias \texttt{SorA}. The value of \texttt{Buffering} is one of the atoms \IdxPO{none}, \IdxPO{line} or \IdxPO{block} as for \IdxPB{open/4} \RefSP{open/4}. This predicate may only be used after opening a stream and before any other operations have been performed on it. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Buffering} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Buffering} is neither a variable nor a valid buffering mode} \ErrTerm{domain\_error(buffering\_mode, Buffering)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Constant term streams} \label{Constant-term-streams} \subsubsection{Introduction} \label{Introduction:(Constant-term-streams)} Constant term streams allow the user to consider a constant term (atom, character list or character code list) as a source/sink by associating to them a stream. Reading from a constant term stream will deliver the characters of the constant term as if they had been read from a standard file. Characters written on a constant term stream are stored to form the final constant term when the stream is closed. The built-in predicates described in this section allow the user to open and close a constant term stream for input or output. However, very often, a constant term stream is created to be only read or written once and then closed. To avoid the creation and the destruction of such a stream, GNU Prolog offers several built-in predicates to perform single input/output from/to constant terms \RefSP{Input/output-from/to-constant-terms}. \subsubsection{\IdxPBD{open\_input\_atom\_stream/2}, \IdxPBD{open\_input\_chars\_stream/2}, \\ \IdxPBD{open\_input\_codes\_stream/2}} \begin{TemplatesOneCol} open\_input\_atom\_stream(+atom, -stream)\\ open\_input\_chars\_stream(+character\_list, -stream)\\ open\_input\_codes\_stream(+character\_code\_list, -stream) \end{TemplatesOneCol} \Description \texttt{open\_input\_atom\_stream(Atom, Stream)} unifies \texttt{Stream} with the stream-term which is associated with a new input text-stream whose data are the characters of \texttt{Atom}. \texttt{open\_input\_chars\_stream(Chars, Stream)} is similar to \texttt{open\_input\_atom\_stream/2} except that data are the content of the character list \texttt{Chars}. \texttt{open\_input\_codes\_stream(Codes, Stream)} is similar to \texttt{open\_input\_atom\_stream/2} except that data are the content of the character code list \texttt{Codes}. \begin{PlErrors} \ErrCond{\texttt{Stream} is not a variable} \ErrTerm{uninstantiation\_error(Stream)} \ErrCond{\texttt{Atom} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Chars} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Codes} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor a an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Chars} is neither a partial list nor a list} \ErrTerm{type\_error(list, Chars)} \ErrCond{\texttt{Codes} is neither a partial list nor a list} \ErrTerm{type\_error(list, Codes)} \ErrCond{an element \texttt{E} of the \texttt{Chars} list is neither a variable nor a character} \ErrTerm{type\_error(character, E)} \ErrCond{an element \texttt{E} of the \texttt{Codes} list is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{an element \texttt{E} of the \texttt{Codes} list is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{close\_input\_atom\_stream/1}, \IdxPBD{close\_input\_chars\_stream/1}, \\ \IdxPBD{close\_input\_codes\_stream/1}} \begin{TemplatesOneCol} close\_input\_atom\_stream(+stream\_or\_alias)\\ close\_input\_chars\_stream(+stream\_or\_alias)\\ close\_input\_codes\_stream(+stream\_or\_alias) \end{TemplatesOneCol} \Description \texttt{close\_input\_atom\_stream(SorA)} closes the constant term stream associated with the stream-term or alias \texttt{SorA}. \texttt{SorA} must a stream open with \texttt{open\_input\_atom\_stream/2} \RefSP{Introduction:(Constant-term-streams)}. \texttt{close\_input\_chars\_stream(SorA)} acts similarly for a character list stream. \texttt{close\_input\_codes\_stream(SorA)} acts similarly for a character code list stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(close, stream, SorA)} \ErrCond{\texttt{SorA} is a stream-term or alias but does not refer to a constant term stream.} \ErrTerm{domain\_error(term\_stream\_or\_alias, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{open\_output\_atom\_stream/1},\label{open-output-atom-stream/1} \IdxPBD{open\_output\_chars\_stream/1}, \\ \IdxPBD{open\_output\_codes\_stream/1}} \begin{TemplatesOneCol} open\_output\_atom\_stream(-stream)\\ open\_output\_chars\_stream(-stream)\\ open\_output\_codes\_stream(-stream) \end{TemplatesOneCol} \Description \texttt{open\_output\_atom\_stream(Stream)} unifies \texttt{Stream} with the stream-term which is associated with a new output text-stream. All characters written to this stream are collected and will be returned as an atom when the stream is closed by \texttt{close\_output\_atom\_stream/2} \RefSP{close-output-atom-stream/2}. \texttt{open\_output\_chars\_stream(Stream)} is similar to \texttt{open\_output\_atom\_stream/1} except that the result will be a character list. \texttt{open\_output\_codes\_stream(Stream)} is similar to \texttt{open\_output\_atom\_stream/1} except that the result will be a character code list. \begin{PlErrors} \ErrCond{\texttt{Stream} is not a variable} \ErrTerm{uninstantiation\_error(Stream)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{close\_output\_atom\_stream/2},\label{close-output-atom-stream/2} \IdxPBD{close\_output\_chars\_stream/2}, \\ \IdxPBD{close\_output\_codes\_stream/2}} \begin{TemplatesOneCol} close\_output\_atom\_stream(+stream\_or\_alias, ?atom)\\ close\_output\_chars\_stream(+stream\_or\_alias, ?character\_list)\\ close\_output\_codes\_stream(+stream\_or\_alias, ?character\_code\_list) \end{TemplatesOneCol} \Description \texttt{close\_output\_atom\_stream(SorA, Atom)} closes the constant term stream associated with the stream-term or alias \texttt{SorA}. \texttt{SorA} must be associated with a stream open with \texttt{open\_output\_atom\_stream/1} \RefSP{open-output-atom-stream/1}. \texttt{Atom} is unified with an atom formed with all characters written on the stream. \texttt{close\_output\_chars\_stream(SorA, Chars)} acts similarly for a character list stream. \texttt{close\_output\_codes\_stream(SorA, Codes)} acts similarly for a character code list stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Chars} is neither a partial list nor a list} \ErrTerm{type\_error(list, Chars)} \ErrCond{\texttt{Codes} is neither a partial list nor a list} \ErrTerm{type\_error(list, Codes)} \ErrCond{an element \texttt{E} of the \texttt{Chars} list is neither a variable nor a character} \ErrTerm{type\_error(character, E)} \ErrCond{an element \texttt{E} of the \texttt{Codes} list is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{an element \texttt{E} of the \texttt{Codes} list is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(close, stream, SorA)} \ErrCond{\texttt{SorA} is a stream-term or alias but does not refer to a constant term stream} \ErrTerm{domain\_error(term\_stream\_or\_alias, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Character input/output} These built-in predicates enable a single character or character code to be input from and output to a text stream. The atom \texttt{end\_of\_file} is returned as character to indicate the end-of-file. \texttt{-1} is returned as character code to indicate the end-of-file. \subsubsection{\IdxPBD{get\_char/2},\label{get-char/2} \IdxPBD{get\_char/1}, \IdxPBD{get\_code/1}, \IdxPBD{get\_code/2}} \begin{TemplatesOneCol} get\_char(+stream\_or\_alias, ?in\_character)\\ get\_char(?in\_character)\\ get\_code(+stream\_or\_alias, ?in\_character\_code)\\ get\_code(?in\_character\_code) \end{TemplatesOneCol} \Description \texttt{get\_char(SorA, Char)} succeeds if \texttt{Char} unifies with the next character read from the stream associated with the stream-term or alias \texttt{SorA}. \texttt{get\_code/2} is similar to \texttt{get\_char/2} but deals with character codes. \texttt{get\_char/1} and \texttt{get\_code/1} apply to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is neither a variable nor an in-character} \ErrTerm{type\_error(in\_character, Char)} \ErrCond{\texttt{Code} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Code)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \ErrCond{The entity input from the stream is not a character} \ErrTerm{representation\_error(character)} \ErrCond{\texttt{Code} is an integer but not an in-character code} \ErrTerm{representation\_error(in\_character\_code)} \end{PlErrors} \Portability ISO predicates. \subsubsection{\IdxPBD{get\_key/2}, \IdxPBD{get\_key/1} \IdxPBD{get\_key\_no\_echo/2}, \IdxPBD{get\_key\_no\_echo/1}} \begin{TemplatesOneCol} get\_key(+stream\_or\_alias, ?integer)\\ get\_key(?integer)\\ get\_key\_no\_echo(+stream\_or\_alias, ?integer)\\ get\_key\_no\_echo(?integer) \end{TemplatesOneCol} \Description \texttt{get\_key(SorA, Code)} succeeds if \texttt{Code} unifies with the character code of the next key read from the stream associated with the stream-term or alias \texttt{SorA}. It is intended to read a single key from the keyboard (thus \texttt{SorA} should refer to current input stream). No buffering is performed (a character is read as soon as available) and function keys can also be read (in that case, \texttt{Code} is an integer $>$ 255). The read character is echoed if it is printable. This facility is only possible if the \IdxK{linedit} facility has been installed \RefSP{The-line-editor} otherwise \texttt{get\_key/2} behaves similarly to \IdxPB{get\_code/2} \RefSP{get-char/2} (the code of the first character is returned) but also pumps remaining characters until a character $<$ space (0x20) is read (in particular RETURN). The same behavior occurs if \texttt{SorA} does not refer to the current input stream or if this stream is not attached to a terminal. \texttt{get\_key\_no\_echo/2} behaves similarly to \texttt{get\_key/2} except that the read character is not echoed. \texttt{get\_key/1} and \texttt{get\_key\_no\_echo/1} apply to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Code} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Code)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{peek\_char/2}, \IdxPBD{peek\_char/1}, \IdxPBD{peek\_code/1}, \IdxPBD{peek\_code/2}} \begin{TemplatesOneCol} peek\_char(+stream\_or\_alias, ?in\_character)\\ peek\_char(?in\_character)\\ peek\_code(+stream\_or\_alias, ?in\_character\_code)\\ peek\_code(?in\_character\_code) \end{TemplatesOneCol} \Description \texttt{peek\_char(SorA, Char)} succeeds if \texttt{Char} unifies with the next character that will be read from the stream associated with the stream-term or alias \texttt{SorA}. The character is not read. \texttt{peek\_code/2} is similar to \texttt{peek\_char/2} but deals with character codes. \texttt{peek\_char/1} and \texttt{peek\_code/1} apply to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is neither a variable nor an in-character} \ErrTerm{type\_error(in\_character, Char)} \ErrCond{\texttt{Code} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Code)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \ErrCond{The entity input from the stream is not a character} \ErrTerm{representation\_error(character)} \ErrCond{\texttt{Code} is an integer but not an in-character code} \ErrTerm{representation\_error(in\_character\_code)} \end{PlErrors} \Portability ISO predicates. \subsubsection{\IdxPBD{unget\_char/2}, \IdxPBD{unget\_char/1}, \IdxPBD{unget\_code/2}, \IdxPBD{unget\_code/1}} \begin{TemplatesOneCol} unget\_char(+stream\_or\_alias, +character)\\ unget\_char(+character)\\ unget\_code(+stream\_or\_alias, +character\_code)\\ unget\_code(+character\_code) \end{TemplatesOneCol} \Description \texttt{unget\_char(SorA, Char)} pushes back \texttt{Char} onto the stream associated with the stream-term or alias \texttt{SorA}. \texttt{Char} will be the next character read by \texttt{get\_char/2}. The maximum number of characters that can be cumulatively pushed back is given by the \IdxPF{max\_unget} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. \texttt{unget\_code/2} is similar to \texttt{unget\_char/2} but deals with character codes. \texttt{unget\_char/1} and \texttt{unget\_code/1} apply to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Code} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is neither a variable nor a character} \ErrTerm{type\_error(character, Char)} \ErrCond{\texttt{Code} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Code)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{Code} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{put\_char/2},\label{put-char/2} \IdxPBD{put\_char/1}, \IdxPBD{put\_code/1}, \IdxPBD{put\_code/2}, \IdxPBD{nl/1}, \IdxPBD{nl/0}} \begin{TemplatesOneCol} put\_char(+stream\_or\_alias, +character)\\ put\_char(+character)\\ put\_code(+stream\_or\_alias, +character\_code)\\ put\_code(+character\_code)\\ nl(+stream\_or\_alias)\\ nl \end{TemplatesOneCol} \Description \texttt{put\_char(SorA, Char)} writes \texttt{Char} onto the stream associated with the stream-term or alias \texttt{SorA}. \texttt{put\_code/2} is similar to \texttt{put\_char/2} but deals with character codes. \texttt{nl(SorA)} writes a new-line character onto the stream associated with the stream-term or alias \texttt{SorA}. This is equivalent to \texttt{put\_char(SorA, '{\bs}n')}. \texttt{put\_char/1}, \texttt{put\_code/1} and \texttt{nl/0} apply to the current output stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Code} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is neither a variable nor a character} \ErrTerm{type\_error(character, Char)} \ErrCond{\texttt{Code} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Code)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(output, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(output, binary\_stream, SorA)} \ErrCond{\texttt{Code} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \end{PlErrors} \Portability ISO predicates. \subsection{Byte input/output} \label{Byte-input/output} These built-in predicates enable a single byte to be input from and output to a binary stream. \texttt{-1} is returned to indicate the end-of-file. \subsubsection{\IdxPBD{get\_byte/2}, \IdxPBD{get\_byte/1}} \begin{TemplatesOneCol} get\_byte(+stream\_or\_alias, ?in\_byte)\\ get\_byte(?in\_byte) \end{TemplatesOneCol} \Description \texttt{get\_byte(SorA, Byte)} succeeds if \texttt{Byte} unifies with the next byte read from the stream associated with the stream-term or alias \texttt{SorA}. \texttt{get\_byte/1} applies to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Byte} is neither a variable nor an in-byte} \ErrTerm{type\_error(in\_byte, Byte)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a text stream} \ErrTerm{permission\_error(input, text\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \end{PlErrors} \Portability ISO predicates. \subsubsection{\IdxPBD{peek\_byte/2}, \IdxPBD{peek\_byte/1}} \begin{TemplatesOneCol} peek\_byte(+stream\_or\_alias, ?in\_byte)\\ peek\_byte(?in\_byte) \end{TemplatesOneCol} \Description \texttt{peek\_byte(SorA, Byte)} succeeds if \texttt{Byte} unifies with the next byte that will be read from the stream associated with the stream-term or alias \texttt{SorA}. The byte is not read. \texttt{peek\_byte/1} applies to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Byte} is neither a variable nor an in-byte} \ErrTerm{type\_error(in\_byte, Byte)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a text stream} \ErrTerm{permission\_error(input, text\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \end{PlErrors} \Portability ISO predicates. \subsubsection{\IdxPBD{unget\_byte/2}, \IdxPBD{unget\_byte/1}} \begin{TemplatesOneCol} unget\_byte(+stream\_or\_alias, +byte)\\ unget\_byte(+byte) \end{TemplatesOneCol} \Description \texttt{unget\_byte(SorA, Byte)} pushes back \texttt{Byte} onto the stream associated with the stream-term or alias \texttt{SorA}. \texttt{Byte} will be the next byte read by \texttt{get\_byte/2}. The maximum number of bytes that can be successively pushed back is given by the \IdxPF{max\_unget} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. \texttt{unget\_byte/1} applies to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Byte} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Byte} is neither a variable nor a byte} \ErrTerm{type\_error(byte, Byte)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a text stream} \ErrTerm{permission\_error(input, text\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{put\_byte/2}, \IdxPBD{put\_byte/1}} \begin{TemplatesOneCol} put\_byte(+stream\_or\_alias, +byte)\\ put\_byte(+byte) \end{TemplatesOneCol} \Description \texttt{put\_byte(SorA, Byte)} writes \texttt{Byte} onto the stream associated with the stream-term or alias \texttt{SorA}. \texttt{put\_byte/1} applies to the current output stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Byte} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Byte} is neither a variable nor a byte} \ErrTerm{type\_error(byte, Byte)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(output, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a text stream} \ErrTerm{permission\_error(output, text\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Term input/output} \label{Term-input/output} These built-in predicates enable a Prolog term to be input from or output to a text stream. The atom \texttt{end\_of\_file} is returned as term to indicate the end-of-file. The syntax of such terms can also be altered by changing the operators \RefSP{op/3:(Term-input/output)}, and making some characters equivalent to others \RefSP{char-conversion/2} if the \IdxPF{char\_conversion} \Idx{Prolog flag} is \texttt{on} \RefSP{set-prolog-flag/2}. Double quoted tokens will be returned as an atom or a character list or a character code list depending on the value of the \IdxPF{double\_quotes} Prolog flag \RefSP{set-prolog-flag/2}. Similarly, back quoted tokens are returned depending on the value of the \IdxPF{back\_quotes} Prolog flag. \subsubsection{\IdxPBD{read\_term/3},\label{read-term/3} \IdxPBD{read\_term/2}, \IdxPBD{read/2}, \IdxPBD{read/1}} \begin{TemplatesOneCol} read\_term(+stream\_or\_alias, ?term, +read\_option\_list)\\ read\_term(?term, +read\_option\_list)\\ read(+stream\_or\_alias, ?term)\\ read(?term) \end{TemplatesOneCol} \Description \texttt{read\_term(SorA, Term, Options)} is true if \texttt{Term} unifies with the next term read from the stream associated with the stream-term or alias \texttt{SorA} according to the options given by \texttt{Options}. \SPart{Read options}: \texttt{Options} is a list of read options. If this list contains contradictory options, the rightmost option is the one which applies. Possible options are: \begin{itemize} \item \AddPOD{variables}\texttt{variables(VL)}: \texttt{VL} is unified with the list of all variables of the input term, in left-to-right traversal order. Anonymous variables are included in the list \texttt{VL}. \item \AddPOD{variable\_names}\texttt{variable\_names(VNL)}: \texttt{VNL} is unified with the list of pairs \texttt{Name = Var} where \texttt{Var} is a named variable of the term and \texttt{Name} is the atom associated with the name of \texttt{Var}. Anonymous variables are not included in the list \texttt{VNL}. The pairs appear in left-to-right traversal order of their \texttt{Var} in the term. \item \AddPOD{singletons}\texttt{singletons(SL)}: \texttt{SL} is unified with the list of pairs \texttt{Name = Var} where \texttt{Var} is a named variable which occurs only once in the term and \texttt{Name} is the atom associated to the name of \texttt{Var}. Anonymous variables are not included in the list \texttt{SL}. \item \AddPOD{syntax\_error}\texttt{syntax\_error(error}/\texttt{warning}/\texttt{fail)}: specifies the effect of a syntax error: \begin{itemize} \item \IdxPOD{error}: a \texttt{syntax\_error} is raised. \item \IdxPOD{warning}: a warning message is displayed and the predicate fails. \item \IdxPOD{fail}: the predicate quietly fails. \end{itemize} The default value is the value of the \IdxPF{syntax\_error} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. \item \AddPOD{end\_of\_term}\texttt{end\_of\_term(dot}/\texttt{eof)}: specifies the end-of-term delimiter: \texttt{dot} is the classical full-stop delimiter (a dot followed with a layout character), \texttt{eof} is the end-of-file delimiter. This option is useful for predicates like \IdxPB{read\_term\_from\_atom/3} \RefSP{read-term-from-atom/3} to avoid to add a terminal dot at the end of the atom. The default value is \texttt{dot}. \end{itemize} \texttt{read(SorA, Term)} is equivalent to \texttt{read\_term(SorA, Term, [])}. \texttt{read\_term/2} and \texttt{read/1} apply to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{Options} is neither a partial list nor a list} \ErrTerm{type\_error(list, Options)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is neither a variable nor a valid read option} \ErrTerm{domain\_error(read\_option, E)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \ErrCond{a syntax error occurs and the value of the \texttt{syntax\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{syntax\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability ISO predicates. The ISO reference raises a \texttt{representation\_error(Flag)} where \texttt{Flag} is \texttt{max\_arity},\texttt{ max\_integer}, or\texttt{ min\_integer} when the read term breaches an implementation defined limit specified by \texttt{Flag}. GNU Prolog detects neither \texttt{min\_integer} nor \texttt{max\_integer} violation and treats a \texttt{max\_arity} violation as a syntax error. The read options \texttt{syntax\_error} and \texttt{end\_of\_term} are GNU Prolog extensions. \subsubsection{\IdxPBD{read\_atom/2},\label{read-atom/2} \IdxPBD{read\_atom/1}, \IdxPBD{read\_integer/2}, \IdxPBD{read\_integer/1}, \\ \IdxPBD{read\_number/2}, \IdxPBD{read\_number/1}} \begin{TemplatesOneCol} read\_atom(+stream\_or\_alias, ?atom)\\ read\_atom(?atom)\\ read\_integer(+stream\_or\_alias, ?integer)\\ read\_integer(?integer)\\ read\_number(+stream\_or\_alias, ?number)\\ read\_number(?number) \end{TemplatesOneCol} \Description \texttt{read\_atom(SorA, Atom)} succeeds if \texttt{Atom} unifies with the next atom read from the stream associated with the stream-term or alias \texttt{SorA}. \texttt{read\_integer(SorA, Integer)} succeeds if \texttt{Integer} unifies with the next integer read from the stream associated with the stream-term or alias \texttt{SorA}. \texttt{read\_number(SorA, Number)} succeeds if \texttt{Number} unifies with the next number (integer or floating point number) read from the stream associated with the stream-term or alias \texttt{SorA}. \texttt{read\_atom/1}, \texttt{read\_integer/1} and \texttt{read\_number/1} apply to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Integer} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Integer)} \ErrCond{\texttt{Number} is neither a variable nor a number} \ErrTerm{type\_error(number, Number)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \ErrCond{a syntax error occurs and the value of the \texttt{syntax\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{syntax\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{read\_token/2},\label{read-token/2} \IdxPBD{read\_token/1}} \begin{TemplatesOneCol} read\_token(+stream\_or\_alias, ?nonvar)\\ read\_token(?nonvar) \end{TemplatesOneCol} \Description \texttt{read\_token(SorA, Token)} succeeds if \texttt{Token} unifies with the encoding of the next Prolog token read from the stream associated with stream-term or alias \texttt{SorA}. \SPart{Token encoding}: \begin{itemize} \item \AddPTD{var}\texttt{var(A)}: a variable is read whose name is the atom \texttt{A}. \item an atom \texttt{A}: an atom \texttt{A} is read. \item integer \texttt{N}: an integer \texttt{N} is read. \item floating point number \texttt{N}: a floating point number \texttt{N} is read. \item \AddPTD{string}\texttt{string(A)}: a string (double quoted item) is read whose characters forms the atom \texttt{A}. \item \AddPTD{punct}\texttt{punct(P)}: a punctuation character \texttt{P} is read (\texttt{P} is a one-character atom in \texttt{()[]{\lb}|{\rb}}, the atom \texttt{full\_stop} or the atom \texttt{end\_of\_file}). \item \AddPTD{back\_quotes}\texttt{back\_quotes(A)}: a back quoted item is read whose characters forms the atom \texttt{A}. \item \AddPTD{extended}\texttt{extended(A)}: an extended character \texttt{A} (an atom) is read. \end{itemize} As for \texttt{read\_term/3}, the behavior of \texttt{read\_token/2} can be affected by some \Add{Prolog flag}\texttt{Prolog flags} \RefSP{Term-input/output}. \texttt{read\_token/1} applies to the current input stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an output stream} \ErrTerm{permission\_error(input, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(input, binary\_stream, SorA)} \ErrCond{\texttt{SorA} has stream properties \texttt{end\_of\_stream(past)} and \texttt{eof\_action(error)}} \ErrTerm{permission\_error(input, past\_end\_of\_stream, SorA)} \ErrCond{a syntax error occurs and the value of the \texttt{syntax\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{syntax\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{syntax\_error\_info/4}\label{syntax-error-info/4}} \begin{TemplatesOneCol} syntax\_error\_info(?atom, ?integer, ?integer, ?atom) \end{TemplatesOneCol} \Description \texttt{syntax\_error\_info(FileName, Line, Column, Error)} returns the information associated with the last syntax error. \texttt{Line} is the line number of the error, \texttt{Column} is the column number of the error and \texttt{Error} is an atom explaining the error. \begin{PlErrors} \ErrCond{\texttt{FileName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, FileName)} \ErrCond{\texttt{Line} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Line)} \ErrCond{\texttt{Column} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Column)} \ErrCond{\texttt{Error} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Error)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{last\_read\_start\_line\_column/2}} \begin{TemplatesOneCol} last\_read\_start\_line\_column(?integer, ?integer) \end{TemplatesOneCol} \Description \texttt{last\_read\_start\_line\_column(Line, Column)} unifies \texttt{Line} and \texttt{Column} with the line number and the column number associated with the start of the last read predicate. This predicate can be used after calling one of the following predicates: \IdxPB{read\_term/3}, \IdxPB{read\_term/2}, \IdxPB{read/2}, \IdxPB{read/1} \RefSP{read-term/3}, \IdxPB{read\_atom/2}, \IdxPB{read\_atom/1}, \IdxPB{read\_integer/2}, \IdxPB{read\_integer/1}, \IdxPB{read\_number/2}, \IdxPB{read\_number/1} \RefSP{read-atom/2} or \IdxPB{read\_token/2}, \IdxPB{read\_token/1} \RefSP{read-token/2}. \begin{PlErrors} \ErrCond{\texttt{Line} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Line)} \ErrCond{\texttt{Column} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Column)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{write\_term/3},\label{write-term/3} \IdxPBD{write\_term/2}, \IdxPBD{write/2}, \IdxPBD{write/1}, \IdxPBD{writeq/2}, \IdxPBD{writeq/1}, \\ \IdxPBD{write\_canonical/2}, \IdxPBD{write\_canonical/1}, \IdxPBD{display/2}, \IdxPBD{display/1}, \IdxPBD{print/2}, \\ \IdxPBD{print/1}} \begin{TemplatesOneCol} write\_term(+stream\_or\_alias, ?term, +write\_option\_list)\\ write\_term(?term, +write\_option\_list)\\ write(+stream\_or\_alias, ?term)\\ write(?term)\\ writeq(+stream\_or\_alias, ?term)\\ writeq(?term)\\ write\_canonical(+stream\_or\_alias, ?term)\\ write\_canonical(?term)\\ display(+stream\_or\_alias, ?term)\\ display(?term)\\ print(+stream\_or\_alias, ?term)\\ print(?term) \end{TemplatesOneCol} \Description \texttt{write\_term(SorA, Term, Options)} writes \texttt{Term} to the stream associated with the stream-term or alias \texttt{SorA} according to the options given by \texttt{Options}. \SPart{Write options}: \texttt{Options} is a list of write options. If this list contains contradictory options, the rightmost option is the one which applies. Possible options are: \begin{itemize} \item \AddPOD{quoted}\texttt{quoted(true}/\texttt{false)}: if \texttt{true} each atom and functor is quoted if this would be necessary for the term to be input by \texttt{read\_term/3}. If \texttt{false} no extra quotes are written. The default value is \texttt{false}. \item \AddPOD{ignore\_ops}\texttt{ignore\_ops(true}/\texttt{false)}: if \texttt{true} each compound term is output in functional notation (neither operator notation nor list notation is used). If \texttt{false} operator and list notations are used. The default value is \texttt{false}. \item \AddPOD{numbervars}\texttt{numbervars(true}/\texttt{false)}: if \texttt{true} a term of the form \texttt{'\$VAR'(N)}, where \texttt{N} is an integer, is output as a variable name (see below). If \texttt{false} such a term is output normally (according to the other options). The default value is \texttt{false}. \item \AddPOD{namevars}\texttt{namevars(true}/\texttt{false)}: if \texttt{true} a term of the form \texttt{'\$VARNAME'(Name)}, where \texttt{Name} is an atom respecting the syntax of variable names, is output as a variable name (see below). If \texttt{false} such a term is output normally (according to the other options). The default value is \texttt{false}. \item \AddPOD{variable\_names}\texttt{variable\_names(VNL)}: \texttt{VNL} is a list of pairs \texttt{Name = Var} where \texttt{Var} is a variable and \texttt{Name} is the atom associated with the name of \texttt{Var}. Each variable \texttt{Var} is written as the atom \texttt{Name} (with \texttt{quoted(false)}) iff a term \texttt{Name = Var} is an element of the list \texttt{VNL}. % If \texttt{Name} is not atom or does not respect the syntax of % variable names the pair is ignored. If several pairs exist for the same variable name the first one applies. \item \AddPOD{space\_args}\texttt{space\_args(true}/\texttt{false)}: if \texttt{true} an extra space character is emitted after each comma separating the arguments of a compound term in functional notation or of a list. If \texttt{false} no extra space is emitted. The default value is \texttt{false}. \item \AddPOD{portrayed}\texttt{portrayed(true}/\texttt{false)}: if \texttt{true} and if there exists a predicate \texttt{portray/1}, \texttt{write\_term/3} acts as follows: if \texttt{Term} is a variable it is simply written. If \texttt{Term} is non-variable then it is passed to \texttt{portray/1}. If this succeeds then it is assumed that \texttt{Term} has been output. Otherwise \texttt{write\_term/3} outputs the principal functor of \texttt{Term} (\texttt{Term} itself if it is atomic) according to other options and recursively calls \texttt{portray/1} on the components of \texttt{Term} (if it is a compound term). With \texttt{ignore\_ops(false)} a list is first passed to \texttt{portray/1} and only if this call fails each element of the list is passed to \texttt{portray/1} (thus every sub-list is not passed). The default value is \texttt{false}. \item \AddPOD{max\_depth}\texttt{max\_depth(N)}: controls the depth of output for compound terms. \texttt{N} is an integer specifying the depth. The output of a term whose depth is greater than \texttt{N} gives rise to the output of \texttt{...} (3 dots). By default there is no depth limit. \item \AddPOD{priority}\texttt{priority(N)}: specifies the starting priority to output the term. This option controls if \texttt{Term} should be enclosed in brackets. \texttt{N} is a positive integer $\leq$ 1200. By default \texttt{N} = 1200. \end{itemize} \SPart{Variable numbering}: when the \texttt{numbervars(true)} option is passed to \texttt{write\_term/3} any term of the form \texttt{'\$VAR'(N)} where \texttt{N} is an integer is output as a variable name consisting of a capital letter possibly followed by an integer. The capital letter is the \texttt{(I+1)}\emph{th} letter of the alphabet and the integer is \texttt{J}, where \texttt{I = N mod 26} and \texttt{J = N // 26}. The integer \texttt{J} is omitted if it is zero. For example: \begin{CodeTwoCols}[2cm] \Two{'\$VAR'(0)}{is written as \texttt{A}} \Two{'\$VAR'(1)}{is written as \texttt{B}} \One{...} \Two{'\$VAR'(25)}{is written as \texttt{Z}} \Two{'\$VAR'(26)}{is written as \texttt{A1}} \Two{'\$VAR'(27)}{is written as \texttt{B1}} \end{CodeTwoCols} \SPart{Variable naming}: when the \texttt{namevars(true)} option is passed to \texttt{write\_term/3} any term of the form \texttt{'\$VARNAME'(Name)} where \texttt{Name} is an atom is output as a variable name consisting of the characters \texttt{Name}. For example: \texttt{'\$VARNAME'('A')} is written as \texttt{A} (even in the presence of the \texttt{quoted(true)} option). \texttt{write(SorA, Term)} is equivalent to \texttt{write\_term(SorA, Term, [numbervars(true), \\ namevars(true)])}. \texttt{writeq(SorA, Term)} is equivalent to \texttt{write\_term(SorA, Term, [quoted(true), \\ numbervars(true), namevars(true)])}. \texttt{write\_canonical(SorA, Term)} is equivalent to \texttt{write\_term(SorA, Term, [quoted(true), \\ ignore\_ops(true), numbervars(false), namevars(false)])}. \texttt{display(SorA, Term)} is equivalent to \texttt{write\_term(SorA, Term, [ignore\_ops(true), \\ numbervars(false), namevars(false)])}. \texttt{print(SorA, Term)} is equivalent to \texttt{write\_term(SorA, Term, [numbervars(false), \\ portrayed(true)])}. \texttt{write\_term/2}, \texttt{write/1}, \texttt{writeq/1}, \texttt{write\_canonical/1}, \texttt{display/1} and \texttt{print/1} apply to the current output stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Options} is neither a partial list nor a list} \ErrTerm{type\_error(list, Options)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{an element \texttt{E} of the \texttt{Options} list is neither a variable nor a valid write-option} \ErrTerm{domain\_error(write\_option, E)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(output, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(output, binary\_stream, SorA)} \end{PlErrors} \Portability ISO predicates except \texttt{display/1-2} and \texttt{print/1-2} that are GNU Prolog predicates. \texttt{namevars}, \texttt{variable\_names} \texttt{space\_args}, \texttt{portrayed}, \texttt{max\_depth} and \texttt{priority} options are GNU Prolog extensions. \subsubsection{\IdxPBD{format/3},\label{format/3} \IdxPBD{format/2}} \begin{TemplatesOneCol} format(+stream\_or\_alias, +character\_code\_list\_or\_atom, +list)\\ format(+character\_code\_list\_or\_atom, +list) \end{TemplatesOneCol} \Description \texttt{format(SorA, Format, Arguments)} writes the \texttt{Format} string replacing each format control sequence \texttt{F} by the corresponding element of \texttt{Arguments} (formatted according to \texttt{F}) to the stream associated with the stream-term or alias \texttt{SorA}. \SPart{Format control sequences}: the general format of a control sequence is \texttt{'\~{}NC'}. The character \texttt{C} determines the type of the control sequence. \texttt{N} is an optional numeric argument. An alternative form of \texttt{N} is \texttt{'*'}. \texttt{'*'} implies that the next argument \texttt{Arg} in \texttt{Arguments} should be used as a numeric argument in the control sequence. The use of C \texttt{printf()} formatting sequence (beginning by the character \texttt{\%}) is also allowed. The following control sequences are available: \begin{tabular}{|C{1.4cm}|C{2.8cm}|p{10.45cm}|} \hline Format sequence & type of the argument & Description \\ \hline\hline \texttt{\~{}Na} & atom & print the atom without quoting. \texttt{N} is minimal number of characters to print using spaces on the right if needed (default: the length of the atom) \\ \hline \texttt{\~{}Nc} & character code & print the character associated with the code. \texttt{N} is the number of times to print the character (default: 1)\\ \hline \texttt{ \~{}Nf} \linebreak \texttt{\~{}Ne \~{}NE \~{}Ng \~{}NG} & float expression & pass the argument \texttt{Arg} and \texttt{N} to the C \texttt{printf()} function as: \linebreak if \texttt{N} is not specified \texttt{printf("\%f",Arg)} else \texttt{printf("\%.Nf",Arg)}. \linebreak Similarly for \texttt{\~{}Ne}, \texttt{\~{}NE}, \texttt{\~{}Ng} and \texttt{\~{}NG} \\ \hline \texttt{\~{}Nd} & integer expression & print the argument. \texttt{N} is the number of digits after the decimal point. If \texttt{N} is 0 no decimal point is printed (default: 0)\\ \hline \texttt{\~{}ND} & integer expression & identical to \texttt{\~{}Nd} except that \texttt{','} separates groups of three digits to the left of the decimal point \\ \hline \texttt{\~{}Nr} & integer expression & print the argument according to the radix \texttt{N}. 2 $\leq$ \texttt{N} $\leq$ 36 (default: 8). The letters \texttt{a-z} denote digits $>$ 9 \\ \hline \texttt{\~{}NR} & integer expression & identical to \texttt{\~{}Nr} except that the letters \texttt{A-Z} denote digits $>$ 9 \\ \hline \texttt{\~{}Ns} & character code list & print exactly \texttt{N} characters (default: the length of the list) \\ \hline \texttt{\~{}NS} & character list & print exactly \texttt{N} characters (default: the length of the list) \\ \hline \texttt{\~{}i} & term & ignore the current argument \\ \hline \texttt{\~{}k} & term & pass the argument to \IdxPB{write\_canonical/1} \RefSP{write-term/3} \\ \hline \texttt{\~{}p} & term & pass the argument to \IdxPB{print/1} \RefSP{write-term/3} \\ \hline \texttt{\~{}q} & term & pass the argument to \IdxPB{writeq/1} \RefSP{write-term/3} \\ \hline \texttt{\~{}w} & term & pass the argument to \IdxPB{write/1} \RefSP{write-term/3} \\ \hline \texttt{\~{}\~{}} & none & print the character \texttt{'\~{}'} \\ \hline \texttt{\~{}Nn} & none & print \texttt{N} new-line characters (default: 1) \\ \hline \texttt{\~{}N} & none & print a new-line character if not at the beginning of a line \\ \hline \texttt{\~{}?} & atom & use the argument as a nested format string \\ \hline \texttt{\%F} & atom, integer or float expression & interface to the C function \texttt{printf(3)} for outputting atoms (C string), integers and floating point numbers. \texttt{*} are also allowed. \\ \hline \end{tabular} \texttt{format/2} applies to the current output stream. \begin{PlErrors} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Format} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Arguments} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Format} is neither a partial list nor a list or an atom} \ErrTerm{type\_error(list, Format)} \ErrCond{\texttt{Arguments} is neither a partial list nor a list} \ErrTerm{type\_error(list, Arguments)} \ErrCond{an element \texttt{E} of the \texttt{Format} list is neither a variable nor a character code} \ErrTerm{representation\_error(character\_code, E)} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{an element \texttt{E} of Format is not a valid format control sequence} \ErrTerm{domain\_error(format\_control\_sequence, E)} \ErrCond{the \texttt{Arguments} list does not contain sufficient elements} \ErrTerm{domain\_error(non\_empty\_list, [])} \ErrCond{an element \texttt{E} of the \texttt{Arguments} list is a variable while a non-variable term was expected} \ErrTerm{instantiation\_error} \ErrCond{an element \texttt{E} of the \texttt{Arguments} list is neither variable nor an atom while an atom was expected} \ErrTerm{type\_error(atom, E)} \ErrCond{an element \texttt{E} of the \texttt{Arguments} cannot be evaluated as an arithmetic expression while an integer or a floating point number was expected} \ErrTermRm{an arithmetic error \RefSP{Evaluation-of-an-arithmetic-expression}} \ErrCond{an element \texttt{E} of the \texttt{Arguments} list is neither variable nor character code while a character code was expected} \ErrTerm{representation\_error(character\_code, E)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(output, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(output, binary\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{portray\_clause/2},\label{portray-clause/2} \IdxPBD{portray\_clause/1}} \begin{TemplatesOneCol} portray\_clause(+stream\_or\_alias, +clause)\\ portray\_clause(+clause) \end{TemplatesOneCol} \Description \texttt{portray\_clause(SorA, Clause)} pretty prints \texttt{Clause} to the stream associated with the stream-term or alias \texttt{SorA}. \texttt{portray\_clause/2} uses the variable binding predicates \IdxPB{name\_singleton\_vars/1} \RefSP{name-singleton-vars/1} and \IdxPB{numbervars/1} \RefSP{bind-variables/2}. This predicate is used by \IdxPB{listing/1} \RefSP{listing/1}. \texttt{portray\_clause/1} applies to the current output stream. \begin{PlErrors} \ErrCond{\texttt{Clause} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Clause} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Clause)} \ErrCond{\texttt{SorA} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{SorA} is neither a variable nor a stream-term or alias} \ErrTerm{domain\_error(stream\_or\_alias, SorA)} \ErrCond{\texttt{SorA} is not associated with an open stream} \ErrTerm{existence\_error(stream, SorA)} \ErrCond{\texttt{SorA} is an input stream} \ErrTerm{permission\_error(output, stream, SorA)} \ErrCond{\texttt{SorA} is associated with a binary stream} \ErrTerm{permission\_error(output, binary\_stream, SorA)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{get\_print\_stream/1}} \begin{TemplatesOneCol} get\_print\_stream(?stream) \end{TemplatesOneCol} \Description \texttt{get\_print\_stream(Stream)} unifies \texttt{Stream} with the stream-term associated with the output stream used by \IdxPB{print/2} \RefSP{write-term/3}. The purpose of this predicate is to allow a user-defined \IdxPB{portray/1} predicate to identify the output stream in use. \begin{PlErrors} \ErrCond{\texttt{Stream} is neither a variable nor a stream-term} \ErrTerm{domain\_error(stream, Stream)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{op/3}\label{op/3:(Term-input/output)}} \begin{TemplatesOneCol} op(+integer, +operator\_specifier, +atom\_or\_atom\_list) \end{TemplatesOneCol} \Description \texttt{op(Priority, OpSpecifier, Operator)} alters the operator table. \texttt{Operator} is declared as an operator with properties defined by specifier \texttt{OpSpecifier} and \texttt{Priority}. \texttt{Priority} must be an integer $\geq$ 0 and $\leq$ 1200. If \texttt{Priority} is 0 then the operator properties of \texttt{Operator} (if any) are canceled. \texttt{Operator} may also be a list of atoms in which case all of them are declared to be operators. In general, operators can be removed from the operator table and their priority or specifier can be changed. However, it is an error to attempt to change the \texttt{','} operator from its initial status. An atom can have multiple operator definitions (e.g. prefix and infix like \texttt{+}) however an atom cannot have both an infix and a postfix operator definitions. \SPart{Operator specifiers}: the following specifiers are available: \begin{tabular}{|c|c|c|} \hline Specifier & Type & Associativity \\ \hline\hline \texttt{fx} & prefix & no \\ \hline \texttt{fy} & prefix & yes \\ \hline \texttt{xf} & postfix & no \\ \hline \texttt{yf} & postfix & yes \\ \hline \texttt{xfx} & infix & no \\ \hline \texttt{yfx} & infix & left \\ \hline \texttt{xfy} & infix & right \\ \hline \end{tabular} \SPart{Prolog predefined operators}: \begin{tabular}{|r|c|L{11cm}|} \hline Priority & Specifier & Operators \\ \hline\hline \texttt{1200} & \texttt{xfx} & \texttt{:- ~--{\gt}} \\ \hline \texttt{1200} & \texttt{fx} & \texttt{:-} \\ \hline \texttt{1105} & \texttt{xfy} & \texttt{|} \\ \hline \texttt{1100} & \texttt{xfy} & \texttt{;} \\ \hline \texttt{1050} & \texttt{xfy} & \texttt{-{\gt} *-{\gt}} \\ \hline \texttt{1000} & \texttt{xfy} & \texttt{,} \\ \hline \texttt{900} & \texttt{fy} & \texttt{{\bs}+} \\ \hline \texttt{700} & \texttt{xfx} & \texttt{= ~{\bs}= ~=.. ~== ~{\bs}== ~@{\lt} ~@={\lt} ~@{\gt} ~@{\gt}= ~is ~=:= ~={\bs}= ~{\lt} ~={\lt} ~{\gt} ~{\gt}=} \\ \hline \texttt{600} & \texttt{xfy} & \texttt{:} \\ \hline \texttt{500} & \texttt{yfx} & \texttt{+ ~- ~/{\bs} ~{\bs}/} \\ \hline \texttt{400} & \texttt{yfx} & \texttt{* ~/ ~// ~rem ~mod ~div ~{\lt}{\lt} ~{\gt}{\gt}} \\ \hline \texttt{200} & \texttt{xfx} & \texttt{** ~\^{}} \\ \hline \texttt{200} & \texttt{fy} & \texttt{+ ~- ~{\bs}} \\ \hline \end{tabular} \SPart{FD predefined operators}: \begin{tabular}{|r|c|L{11cm}|} \hline Priority & Specifier & Operators \\ \hline\hline \texttt{750} & \texttt{xfy} & \texttt{\#{\lt}={\gt} ~\#{\bs}{\lt}={\gt}} \\ \hline \texttt{740} & \texttt{xfy} & \texttt{\#=={\gt} ~\#{\bs}=={\gt}} \\ \hline \texttt{730} & \texttt{xfy} & \texttt{\#\# ~\#{\bs}/ ~\#{\bs}{\bs}/} \\ \hline \texttt{720} & \texttt{yfx} & \texttt{\#/{\bs} ~\#{\bs}/{\bs}} \\ \hline \texttt{710} & \texttt{fy} & \texttt{\#{\bs}} \\ \hline \texttt{700} & \texttt{xfx} & \texttt{\#= ~\#{\bs}= ~\#{\lt} ~\#={\lt} ~\#{\gt} ~\#{\gt}= ~\#=\# ~\#{\bs}=\# ~\#{\lt}\# ~\#={\lt}\# ~\#{\gt}\# ~\#{\gt}=\#} \\ \hline \texttt{500} & \texttt{yfx} & \texttt{+ ~-} \\ \hline \texttt{400} & \texttt{yfx} & \texttt{* ~/ ~// ~rem} \\ \hline \texttt{200} & \texttt{xfy} & \texttt{**} \\ \hline \texttt{200} & \texttt{fy} & \texttt{+ ~-} \\ \hline \end{tabular} \begin{PlErrors} \ErrCond{\texttt{Priority} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{OpSpecifier} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Operator} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Priority} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Priority)} \ErrCond{\texttt{OpSpecifier} is neither a variable nor an atom} \ErrTerm{type\_error(atom, OpSpecifier)} \ErrCond{\texttt{Operator} is neither a partial list nor a list nor an atom} \ErrTerm{type\_error(list, Operator)} \ErrCond{an element \texttt{E} of the \texttt{Operator} list is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{\texttt{Priority} is an integer not $\geq$ 0 and $\leq$ 1200} \ErrTerm{domain\_error(operator\_priority, Priority)} \ErrCond{\texttt{OpSpecifier} is not a valid operator specifier} \ErrTerm{domain\_error(operator\_specifier, OpSpecifier)} \ErrCond{\texttt{Operator} (or an element of the \texttt{Operator} list) is \texttt{','}} \ErrTerm{permission\_error(modify, operator, ',')} \ErrCond{\texttt{OpSpecifier} is a specifier such that \texttt{Operator} would have a postfix and an infix definition. } \ErrTerm{permission\_error(create, operator, Operator)} \ErrCond{\texttt{Operator} (or an element of the \texttt{Operator} list) is \texttt{|} and it would have a prefix or a postfix definition or its \texttt{Priority} would be $\leq$ 1100.} \ErrTerm{permission\_error(create, operator, '|')} \ErrCond{\texttt{Operator} (or an element of the \texttt{Operator} list) is \texttt{[]} or \texttt{{\lb}{\rb}}.} \ErrTerm{permission\_error(create, operator, Operator)} \end{PlErrors} \Portability ISO predicate. The ISO reference implies that if a program calls \texttt{current\_op/3}, then modifies an operator definition by calling \texttt{op/3} and backtracks into the call to \texttt{current\_op/3}, then the changes are guaranteed not to affect that \texttt{current\_op/3} goal. This is not guaranteed by GNU Prolog. \subsubsection{\IdxPBD{current\_op/3}} \begin{TemplatesOneCol} current\_op(?integer, ?operator\_specifier, ?atom) \end{TemplatesOneCol} \Description \texttt{current\_op(Priority, OpSpecifier, Operator)} succeeds if \texttt{Operator} is an operator with properties defined by specifier \texttt{OpSpecifier} and \texttt{Priority}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Priority} is neither a variable nor an operator priority} \ErrTerm{domain\_error(operator\_priority, Priority)} \ErrCond{\texttt{OpSpecifier} is neither a variable nor an operator specifier} \ErrTerm{domain\_error(operator\_specifier, OpSpecifier)} \ErrCond{\texttt{Operator} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Operator)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{char\_conversion/2}\label{char-conversion/2}} \begin{TemplatesOneCol} char\_conversion(+character, +character) \end{TemplatesOneCol} \Description \texttt{char\_conversion(InChar, OutChar)} alters the character-conversion mapping. This mapping is used by the following read predicates: \IdxPB{read\_term/3} \RefSP{read-term/3}, \IdxPB{read\_atom/2}, \IdxPB{read\_integer/2}, \IdxPB{read\_number/2} \RefSP{read-atom/2} and \IdxPB{read\_token/2} \RefSP{read-token/2} to replace any occurrence of a character \texttt{InChar} by \texttt{OutChar}. However the conversion mechanism should have been previously activated by switching on the \IdxPF{char\_conversion} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. When \texttt{InChar} and \texttt{OutChar} are the same, the effect is to remove any conversion of a character \texttt{InChar}. Note that the single character read predicates (e.g. \texttt{get\_char/2}) never do character conversion. If such behavior is required, it must be explicitly done using \texttt{current\_char\_conversion/2} \RefSP{current-char-conversion/2}. \begin{PlErrors} \ErrCond{\texttt{InChar} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{OutChar} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{InChar} is neither a variable nor a character} \ErrTerm{type\_error(character, InChar)} \ErrCond{\texttt{OutChar} is neither a variable nor a character} \ErrTerm{type\_error(character, OutChar)} \end{PlErrors} \Portability ISO predicate. The \texttt{type\_error(character,\ldots)} is a GNU Prolog behavior, the ISO reference instead defines a \texttt{representation\_error(character)} in this case. This seems to be an error of the ISO reference since, for many other built-in predicates accepting a character (e.g. \texttt{char\_code/2}, \texttt{put\_char/2}), a \texttt{type\_error} is raised. The ISO reference implies that if a program calls \texttt{current\_char\_conversion/2}, then modifies the character mapping by calling \texttt{char\_conversion/2}, and backtracks into the call to \texttt{current\_char\_conversion/2} then the changes are guaranteed not to affect that \texttt{current\_char\_conversion/2} goal. This is not guaranteed by GNU Prolog. \subsubsection{\IdxPBD{current\_char\_conversion/2}\label{current-char-conversion/2}} \begin{TemplatesOneCol} current\_char\_conversion(?character, ?character) \end{TemplatesOneCol} \Description \texttt{current\_char\_conversion(InChar, OutChar)} succeeds if the conversion of \texttt{InChar} is \texttt{OutChar} according to the character-conversion mapping. In that case, \texttt{InChar} and \texttt{OutChar} are different. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{InChar} is neither a variable nor a character} \ErrTerm{type\_error(character, InChar)} \ErrCond{\texttt{OutChar} is neither a variable nor a character} \ErrTerm{type\_error(character, OutChar)} \end{PlErrors} \Portability ISO predicate. Same remark as for char\_conversion/2 \RefSP{char-conversion/2}. \subsection{Input/output from/to constant terms} \label{Input/output-from/to-constant-terms} These built-in predicates enable a Prolog term to be input from or output to a Prolog constant term (atom, character list or character code list). All these predicates can be defined using constant term streams \RefSP{Constant-term-streams}. They are however simpler to use. \subsubsection{\IdxPBD{read\_term\_from\_atom/3},\label{read-term-from-atom/3} \IdxPBD{read\_from\_atom/2}, \IdxPBD{read\_token\_from\_atom/2}} \begin{TemplatesOneCol} read\_term\_from\_atom(+atom ?term, +read\_option\_list)\\ read\_from\_atom(+atom, ?term)\\ read\_token\_from\_atom(+atom, ?nonvar) \end{TemplatesOneCol} \Description \texttt{}% \texttt{}% \texttt{}% Like \IdxPB{read\_term/3}, \IdxPB{read/2} \RefSP{read-term/3} and \IdxPB{read\_token/2} \RefSP{read-token/2} except that characters are not read from a text-stream but from \texttt{Atom}; the atom given as first argument. \begin{PlErrors} \ErrCond{\texttt{Atom} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{see associated predicate errors} \ErrTermRm{\RefSP{read-term/3} and \RefSP{read-token/2}} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{read\_term\_from\_chars/3}, \IdxPBD{read\_from\_chars/2}, \IdxPBD{read\_token\_from\_chars/2}} \begin{TemplatesOneCol} read\_term\_from\_chars(+character\_list ?term, +read\_option\_list)\\ read\_from\_chars(+character\_list, ?term)\\ read\_token\_from\_chars(+character\_list, ?nonvar) \end{TemplatesOneCol} \Description \texttt{}% \texttt{}% \texttt{}% Like \IdxPB{read\_term/3}, \IdxPB{read/2} \RefSP{read-term/3} and \IdxPB{read\_token/2} \RefSP{read-token/2} except that characters are not read from a text-stream but from \texttt{Chars}; the character list given as first argument. \begin{PlErrors} \ErrCond{\texttt{Chars} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Chars} is neither a partial list nor a list} \ErrTerm{type\_error(list, Chars)} \ErrCond{an element \texttt{E} of the \texttt{Chars} list is neither a variable nor a character} \ErrTerm{type\_error(character, E)} \ErrCond{see associated predicate errors} \ErrTermRm{\RefSP{read-term/3} and \RefSP{read-token/2}} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{read\_term\_from\_codes/3}, \IdxPBD{read\_from\_codes/2}, \IdxPBD{read\_token\_from\_codes/2}} \begin{TemplatesOneCol} read\_term\_from\_codes(+character\_code\_list ?term, +read\_option\_list)\\ read\_from\_codes(+character\_code\_list, ?term)\\ read\_token\_from\_codes(+character\_code\_list, ?nonvar) \end{TemplatesOneCol} \Description \texttt{}% \texttt{}% \texttt{}% Like \IdxPB{read\_term/3}, \IdxPB{read/2} \RefSP{read-term/3} and \IdxPB{read\_token/2} \RefSP{read-token/2} except that characters are not read from a text-stream but from \texttt{Codes}; the character code list given as first argument. \begin{PlErrors} \ErrCond{\texttt{Codes} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Codes} is neither a partial list nor a list} \ErrTerm{type\_error(list, Codes)} \ErrCond{an element \texttt{E} of the \texttt{Codes} list is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{an element \texttt{E} of the \texttt{Codes} list is an integer but not a character code} \ErrTerm{representation\_error(character\_code, E)} \ErrCond{see associated predicate errors} \ErrTermRm{\RefSP{read-term/3} and \RefSP{read-token/2}} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{write\_term\_to\_atom/3}, \IdxPBD{write\_to\_atom/2}, \IdxPBD{writeq\_to\_atom/2}, \\ \IdxPBD{write\_canonical\_to\_atom/2}, \IdxPBD{display\_to\_atom/2}, \IdxPBD{print\_to\_atom/2}, \\ \IdxPBD{format\_to\_atom/3}} \begin{TemplatesOneCol} write\_term\_to\_atom(?atom, ?term, +write\_option\_list)\\ write\_to\_atom(?atom, ?term)\\ writeq\_to\_atom(?atom, ?term)\\ write\_canonical\_to\_atom(?atom, ?term)\\ display\_to\_atom(?atom, ?term)\\ print\_to\_atom(?atom, ?term)\\ format\_to\_atom(?atom, +character\_code\_list\_or\_atom, +list) \end{TemplatesOneCol} \Description \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% Similar to \IdxPB{write\_term/3}, \IdxPB{write/2}, \IdxPB{writeq/2}, \IdxPB{write\_canonical/2}, \IdxPB{display/2}, \IdxPB{print/2} \RefSP{write-term/3} and \IdxPB{format/3} \RefSP{format/3} except that characters are not written onto a text-stream but are collected as an atom which is then unified with the first argument \texttt{Atom}. \begin{PlErrors} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{see associated predicate errors} \ErrTermRm{\RefSP{write-term/3} and \RefSP{format/3}} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{write\_term\_to\_chars/3}, \IdxPBD{write\_to\_chars/2}, \IdxPBD{writeq\_to\_chars/2}, \\ \IdxPBD{write\_canonical\_to\_chars/2}, \IdxPBD{display\_to\_chars/2}, \IdxPBD{print\_to\_chars/2}, \\ \IdxPBD{format\_to\_chars/3}} \begin{TemplatesOneCol} write\_term\_to\_chars(?character\_list, ?term, +write\_option\_list)\\ write\_to\_chars(?character\_list, ?term)\\ writeq\_to\_chars(?character\_list, ?term)\\ write\_canonical\_to\_chars(?character\_list, ?term)\\ display\_to\_chars(?character\_list, ?term)\\ print\_to\_chars(?character\_list, ?term)\\ format\_to\_chars(?character\_list, +character\_code\_list\_or\_atom, +list) \end{TemplatesOneCol} \Description \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% Similar to \IdxPB{write\_term/3}, \IdxPB{write/2}, \IdxPB{writeq/2}, \IdxPB{write\_canonical/2}, \IdxPB{display/2}, \IdxPB{print/2} \RefSP{write-term/3} and \IdxPB{format/3} \RefSP{format/3} except that characters are not written onto a text-stream but are collected as a character list which is then unified with the first argument \texttt{Chars}. \begin{PlErrors} \ErrCond{\texttt{Chars} is neither a partial list nor a list} \ErrTerm{type\_error(list, Chars)} \ErrCond{An element \texttt{E} of the list \texttt{Chars} is neither a variable nor a one-char atom} \ErrTerm{type\_error(character, E)} \ErrCond{see associated predicate errors} \ErrTermRm{\RefSP{write-term/3} and \RefSP{format/3}} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPB{write\_term\_to\_codes/3}, \IdxPBD{write\_to\_codes/2}, \IdxPBD{writeq\_to\_codes/2}, \\ \IdxPBD{write\_canonical\_to\_codes/2}, \IdxPBD{display\_to\_codes/2}, \IdxPBD{print\_to\_codes/2}, \\ \IdxPBD{format\_to\_codes/3}} \begin{TemplatesOneCol} write\_term\_to\_codes(?character\_code\_list, ?term, +write\_option\_list)\\ write\_to\_codes(?character\_code\_list, ?term)\\ writeq\_to\_codes(?character\_code\_list, ?term)\\ write\_canonical\_to\_codes(?character\_code\_list, ?term)\\ display\_to\_codes(?character\_code\_list, ?term)\\ print\_to\_codes(?character\_code\_list, ?term)\\ format\_to\_codes(?character\_code\_list, +character\_code\_list\_or\_atom, +list) \end{TemplatesOneCol} \Description \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% \texttt{}% Similar to \IdxPB{write\_term/3}, \IdxPB{write/2}, \IdxPB{writeq/2}, \IdxPB{write\_canonical/2}, \IdxPB{display/2}, \IdxPB{print/2} \RefSP{write-term/3} and \IdxPB{format/3} \RefSP{format/3} except that characters are not written onto a text-stream but are collected as a character code list which is then unified with the first argument \texttt{Codes}. \begin{PlErrors} \ErrCond{\texttt{Codes} is neither a partial list nor a list} \ErrTerm{type\_error(list, Codes)} \ErrCond{An element \texttt{E} of the list \texttt{Codes} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{An element \texttt{E} of the list \texttt{Codes} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \ErrCond{see associated predicate errors} \ErrTermRm{\RefSP{write-term/3} and \RefSP{format/3}} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{DEC-10 compatibility input/output} \subsubsection{Introduction} The DEC-10 Prolog I/O predicates manipulate streams implicitly since they only refer to current input/output streams \RefSP{Introduction:(Streams)}. The current input and output streams are initially set to \IdxPK{user\_input} and \IdxPK{user\_output} respectively. The predicate \texttt{see/1} (resp. \texttt{tell/1}, \texttt{append/1}) can be used for setting the current input (resp. output) stream to newly opened streams for particular files. The predicate \texttt{seen/0} (resp. \texttt{told/0}) close the current input (resp. output) stream, and resets it to the standard input (resp. output). The predicate \texttt{seeing/1} (resp. \texttt{telling/1}) is used for retrieving the file name associated with the current input (resp. output) stream. The file name \IdxPKD{user} stands for the standard input or output, depending on context (\IdxPK{user\_input} and \IdxPK{user\_output} can also be used). The DEC-10 Prolog I/O predicates are only provided for compatibility, they are now obsolete and their use is discouraged. The predicates for explicit stream manipulation should be used instead \RefSP{Streams}. \subsubsection{\IdxPBD{see/1}, \IdxPBD{tell/1}, \IdxPBD{append/1}} \begin{TemplatesOneCol} see(+source\_sink)\\ see(+stream)\\ tell(+source\_sink)\\ tell(+stream)\\ append(+source\_sink)\\ append(+stream) \end{TemplatesOneCol} \Description \texttt{see(FileName)} sets the current input stream to \texttt{FileName}. If there is a stream opened by \texttt{see/1} associated with the same \texttt{FileName} already, then it becomes the current input stream. Otherwise, \texttt{FileName} is opened for reading and becomes the current input stream. \texttt{tell(FileName)} sets the current output stream to \texttt{FileName}. If there is a stream opened by \texttt{tell/1} associated with the same \texttt{FileName} already, then it becomes the current output stream. Otherwise, \texttt{FileName} is opened for writing and becomes the current output stream. \texttt{append(FileName)} like \texttt{tell/1} but \texttt{FileName} is opened for writing + append. A stream-term (obtained with any other built-in predicate) can also be provided as \texttt{FileName} to these predicates. \Errors See errors associated with \texttt{open/4} \RefSP{open/4}. \Portability GNU Prolog predicates. Deprecated. \subsubsection{\IdxPBD{seeing/1}, \IdxPBD{telling/1}} \begin{TemplatesOneCol} seeing(?source\_sink)\\ telling(?source\_sink) \end{TemplatesOneCol} \Description \texttt{seeing(FileName)} succeeds if \texttt{FileName} unifies with the name of the current input file, if it was opened by \texttt{see/1}; else with the current input stream-term, if this is not \IdxPK{user\_input}, otherwise with \IdxPK{user}. \texttt{telling(FileName)} succeeds if \texttt{FileName} unifies with the name of the current output file, if it was opened by \texttt{tell/1} or \texttt{append/1}; else with the current output stream-term, if this is not \IdxPK{user\_output}, otherwise with \IdxPK{user}. \PlErrorsNone \Portability GNU Prolog predicates. Deprecated. \subsubsection{\IdxPBD{seen/0}, \IdxPBD{told/0}} \begin{TemplatesOneCol} seen\\ told \end{TemplatesOneCol} \Description \texttt{seen} closes the current input, and resets it to \IdxPK{user\_input}. \texttt{told} closes the current output, and resets it to \IdxPK{user\_output}. \PlErrorsNone \Portability GNU Prolog predicates. Deprecated. \subsubsection{\IdxPBD{get0/1}, \IdxPBD{get/1}, \IdxPBD{skip/1}} \begin{TemplatesOneCol} get0(?in\_character\_code)\\ get(?in\_character\_code)\\ skip(+character\_code) \end{TemplatesOneCol} \Description \texttt{get0(Code)} succeeds if \texttt{Code} unifies with the next character code read from the current input stream. Thus it is equivalent to \texttt{get\_code(Code)} \RefSP{get-char/2}. \texttt{get(Code)} succeeds if \texttt{Code} unifies with the next character code read from the current input stream that is not a layout character. \texttt{skip(Code)} skips just past the next character code \texttt{Code} from the current input stream. \Errors See errors for \texttt{get\_code/2} \RefSP{get-char/2}. \Portability GNU Prolog predicates. Deprecated. \subsubsection{\IdxPBD{put/1}, \IdxPBD{tab/1}} \begin{TemplatesOneCol} put(+character\_code)\\ tab(+evaluable) \end{TemplatesOneCol} \Description \texttt{put(Code)} writes the character whose code is \texttt{Code} onto the current output stream. It is equivalent to \texttt{put\_code(Code)} \RefSP{put-char/2}. \texttt{tab(N)} writes \texttt{N} spaces onto the current output stream. \texttt{N} may be an arithmetic expression. \Errors See errors for \texttt{put\_code/2} \RefSP{put-char/2} and for arithmetic expressions \RefSP{Evaluation-of-an-arithmetic-expression}. \Portability GNU Prolog predicates. Deprecated. \subsection{Term expansion} \label{Term-expansion} \subsubsection{Definite clause grammars} \label{DCG} \index{Definite clause grammars|see {DCG}} Definite clause grammars are a useful notation to express grammar rules. However the ISO reference does not include them, so they should be considered as a system dependent feature. Definite clause grammars are an extension of context-free grammars. A grammar rule is of the form: \OneLine{\textrm{head} \AddPKD{(--{\gt})/2}\texttt{--{\gt}} \textrm{body}.} \texttt{--{\gt}} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. Here are some features of definite clause grammars: \begin{itemize} \item a non-terminal symbol may be any callable term. \item a terminal symbol may be any Prolog term and is written as a list. The empty list represents an empty sequence of terminals. \item a sequence is expressed using the Prolog conjunction operator \texttt((',')/2). \item the head of a grammar rule consists of a non-terminal optionally followed by a sequence of terminals (i.e. a Prolog list). \item the body of a grammar rule consists of a sequence of non-terminals, terminals, predicate call, disjunction (using \texttt{;/2}), if-then (using \texttt{(-{\gt})/2}) or cut (using \texttt{!}). \item a predicate call must be enclosed in curly brackets (using \texttt{{\lb}{\rb}/1}). This makes it possible to express an extra condition. \end{itemize} A grammar rule is nothing but a ``syntactic sugar'' for a Prolog clause. Each grammar rule accepts as input a list of terminals (tokens), parses a prefix of this list and gives as output the rest of this list (possibly enlarged). This rest is generally parsed later. So, each a grammar rule is translated into a Prolog clause that explicitly the manages the list. Two arguments are then added: the input list (\texttt{Start}) and the output list (\texttt{End}). For instance: \OneLine{p --{\gt} q.} is translated into: \OneLine{p(Start, End) :- q(Start, End).} Extra arguments can be provided and the body of the rule can contain several non-terminals. Example: \begin{Indentation} \begin{verbatim} p(X, Y) --> q(X), r(X, Y), s(Y). \end{verbatim} \end{Indentation} is translated into: \begin{Indentation} \begin{verbatim} p(X, Y, Start, End) :- q(X, Start, A), r(X, Y, A, B), s(Y, B, End). \end{verbatim} \end{Indentation} Terminals are translated using unification: \OneLine{assign(X,Y) --{\gt} left(X), [:=], right(Y), [;].} is translated into: \begin{Indentation} \begin{verbatim} assign(X,Y,Start,End) :- left(X, Start, A), A=[:=|B], right(Y, B, C), C=[;|End]. \end{verbatim} \end{Indentation} Terminals appearing on the left-hand side of a rule are connected to the output argument of the head. It is possible to include a call to a prolog predicate enclosing it in curly brackets (to distinguish them from non-terminals): \OneLine{assign(X,Y) --{\gt} left(X), [:=], right(Y0), {\lb}Y is Y0 {\rb}, [;].} is translated into: \begin{Indentation} \begin{verbatim} assign(X,Y,Start,End) :- left(X, Start, A), A=[:=|B], right(Y0, B, C), Y is Y0, C=[;|End]. \end{verbatim} \end{Indentation} Cut, disjunction and if-then(-else) are translated literally (and do not need to be enclosed in curly brackets). \subsubsection{\IdxPBD{expand\_term/2},\label{expand-term/2} \IdxPBD{term\_expansion/2}} \begin{TemplatesOneCol} expand\_term(?term, ?term)\\ term\_expansion(?term, ?term) \end{TemplatesOneCol} \Description \texttt{expand\_term(Term1, Term2)} succeeds if \texttt{Term2} is a transformation of \texttt{Term1}. The transformation steps are as follows: \begin{itemize} \item if \texttt{Term1} is a variable, it is unified with \texttt{Term2} \item if \texttt{term\_expansion(Term1, Term2)} succeeds \texttt{Term2} is assumed to be the transformation of \texttt{Term1}. \item if \texttt{Term1} is a DCG then \texttt{Term2} is its translation \RefSP{DCG}. \item otherwise \texttt{Term2} is unified with \texttt{Term1}. \end{itemize} \texttt{term\_expansion(Term1, Term2)} is a hook predicate allowing the user to define a specific transformation. The GNU Prolog compiler \RefSP{The-GNU-Prolog-compiler} automatically calls \texttt{expand\_term/2} on each \texttt{Term1} read in. However, in the current release, only DCG transformation are done by the compiler (i.e. \texttt{term\_expansion/2} cannot be used). To use \texttt{term\_expansion/2}, it is necessary to call \texttt{expand\_term/2} explicitly. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{phrase/3}, \IdxPBD{phrase/2}} \begin{TemplatesOneCol} phrase(?term, ?list, ?list)\\ phrase(?term, ?list) \end{TemplatesOneCol} \Description \texttt{phrase(Phrase, List, Remainder)} succeeds if the list \texttt{List} is in the language defined by the grammar rule body \texttt{Phrase}. \texttt{Remainder} is what remains of the list after a phrase has been found. \texttt{phrase(Phrase, List)} is equivalent to \texttt{phrase(Phrase, List, [])}. \begin{PlErrors} \ErrCond{\texttt{Phrase} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Phrase} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Phrase)} \ErrCond{\texttt{List} is neither a list nor a partial list} \ErrTerm{type\_error(list, List)} \ErrCond{\texttt{Remainder} is neither a list nor a partial list} \ErrTerm{type\_error(list, Remainder)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Logic, control and exceptions} \subsubsection{\IdxPBD{abort/0},\label{abort/0} \IdxPBD{stop/0}, \IdxPBD{top\_level/0}, \IdxPBD{break/0}, \IdxPBD{halt/1}, \IdxPBD{halt/0}} \begin{TemplatesOneCol} abort\\ stop\\ top\_level\\ break\\ halt(+integer)\\ halt \end{TemplatesOneCol} \Description \texttt{abort} aborts the current execution. If this execution was initiated under a \Idx{top-level} the control is given back to the top-level and the message \texttt{{\lb}execution aborted{\rb}} is displayed. Otherwise, e.g. execution started by a \texttt{initialization/1} directive \RefSP{initialization/1}, \texttt{abort/0} is equivalent to \texttt{halt(1)} (see below). \texttt{stop} stops the current execution. If this execution was initiated under a \Idx{top-level} the control is given back to the top-level. Otherwise, \texttt{stop/0} is equivalent to \texttt{halt(0)} (see below). \texttt{top\_level} starts a new recursive \Idx{top-level} (including the banner display). To end this new \Idx{top-level} simply type the end-of-file key sequence (\texttt{Ctl-D}) or its term representation: \texttt{end\_of\_file.} \texttt{break} invokes a recursive top-level (no banner is displayed). To end this new level simply type the end-of-file key sequence (\texttt{Ctl-D}) or its term representation: \texttt{end\_of\_file.} \texttt{halt(Status)} causes the GNU Prolog process to immediately exit back to the shell with the return code \texttt{Status}. \texttt{halt} is equivalent to \texttt{halt(0)}. \begin{PlErrors} \ErrCond{\texttt{Status} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Status} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Status)} \end{PlErrors} \Portability \texttt{halt/1} and \texttt{halt/0} are ISO predicates. \texttt{abort/0}, \texttt{stop/0}, \texttt{top\_level/0} and \texttt{break/0} are GNU Prolog predicates. \subsubsection{\IdxPBD{false/0}, \IdxPBD{once/1}, \IdxPBD{({\bs}+)/1} - not provable, \IdxPBD{call/2-11}, \IdxPBD{call\_with\_args/1-11}, \IdxPBD{call\_det/2}, \IdxPBD{forall/2}} \begin{TemplatesOneCol} false\\ once(+callable\_term)\\ {\bs}+(+callable\_term) \\ call(+callable\_term, +term,\ldots, +term)\\ call\_with\_args(+atom, +term,\ldots, +term)\\ call\_det(+callable\_term, ?boolean) \\ forall(+callable\_term, +callable\_term) \end{TemplatesOneCol} \Description \texttt{false} always fails and enforces backtracking. It is equivalent to the \IdxCC{fail/0} control construct \RefSP{true/0}. \texttt{once(Goal)} succeeds if \texttt{call(Goal)} succeeds. However \texttt{once/1} is not re-executable on backtracking since all alternatives of \texttt{Goal} are cut. \texttt{once(Goal)} is equivalent to \texttt{call(Goal), !}. \texttt{{\bs}+ Goal} succeeds if \texttt{call(Goal)} fails and fails otherwise. This built-in predicate gives negation by failure. \texttt{call(Closure, Arg1,\ldots, ArgN)} calls the goal \texttt{call(Goal)} where \texttt{Goal} is constructed by appending \texttt{Arg1,\ldots, ArgN} ($1 \leq \texttt{N} \leq 10$) additional arguments to the arguments (if any) of \texttt{Closure}. \texttt{call\_with\_args(Functor, Arg1,\ldots, ArgN)} calls the goal whose functor is \texttt{Functor} and whose arguments are \texttt{Arg1},\ldots, \texttt{ArgN} ($0 \leq \texttt{N} \leq 10$). \texttt{call\_det(Goal, Deterministic)} succeeds if \texttt{call(Goal)} succeeds and unifies \texttt{Deterministic} with \texttt{true} if \texttt{Goal} has not created any choice-points, with \texttt{false} otherwise. \texttt{forall(Condition, Action)} succeeds if for all alternative bindings of \texttt{Condition}, \texttt{Action} can be proven. It is equivalent to \texttt{{\bs}+ (Condition, {\bs}+ Action)}. \texttt{{\bs}+} is a predefined prefix operator \RefSP{op/3:(Term-input/output)}. \begin{PlErrors} \ErrCond{\texttt{Goal} (or \texttt{Condition} or \texttt{Action}) is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Goal} (or \texttt{Condition} or \texttt{Action}) is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Goal} does not correspond to an existing procedure and the value of the \texttt{unknown} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{existence\_error(procedure, Pred)} \ErrCond{\texttt{Functor} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Functor} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Functor)} \ErrCond{\texttt{Deterministic} is neither a variable nor a boolean} \ErrTerm{type\_error(boolean, Deterministic)} \ErrCond{for \texttt{call/2-11} the resulting arity of \texttt{Goal} (arity of $\texttt{Closure} + \texttt{N}$) is an integer $>$ \texttt{max\_arity} flag \RefSP{set-prolog-flag/2}} \ErrTerm{representation\_error(max\_arity)} \end{PlErrors} \Portability \texttt{false/0}, \texttt{call/2-8}, \texttt{once/1} and \texttt{({\bs}+)/1} are ISO predicates. \texttt{call/9-11}, \texttt{call\_with\_args/1-11}, \texttt{call\_det/2} and \texttt{forall/2} are GNU Prolog predicates. \subsubsection{\IdxPBD{repeat/0}} \begin{TemplatesOneCol} repeat \end{TemplatesOneCol} \Description \texttt{repeat} generates an infinite sequence of backtracking choices. The purpose is to repeatedly perform some action on elements which are somehow generated, e.g. by reading them from a stream, until some test becomes true. Repeat loops cannot contribute to the logic of the program. They are only meaningful if the action involves side-effects. The only reason for using repeat loops instead of a more natural tail-recursive formulation is efficiency: when the test fails back, the Prolog engine immediately reclaims any working storage consumed since the call to \texttt{repeat/0}. \PlErrorsNone \Portability ISO predicate. \subsubsection{\IdxPBD{between/3}, \IdxPBD{for/3}} \begin{TemplatesOneCol} between(+integer, +integer, ?integer) \\ for(?integer, +integer, +integer) \end{TemplatesOneCol} \Description \texttt{between(Lower, Upper, Counter)} generates an sequence of backtracking choices instantiating \texttt{Counter} to the values \texttt{Lower}, \texttt{Lower+1},\ldots, \texttt{Upper}. \texttt{for(Counter, Lower, Upper)} is equivalent to \texttt{between(Lower, Upper, Counter)}. This predicate is deprecated and new code should use \texttt{between/3}. \begin{PlErrors} \ErrCond{\texttt{Counter} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Counter)} \ErrCond{\texttt{Lower} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Lower} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Lower)} \ErrCond{\texttt{Upper} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Upper} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Upper)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Atomic term processing} These built-in predicates enable atomic terms to be processed as a sequence of characters and character codes. Facilities exist to split and join atoms, to convert a single character to and from the corresponding character code, and to convert a number to and from a list of characters and character codes. \subsubsection{\IdxPBD{atom\_length/2}} \begin{TemplatesOneCol} atom\_length(+atom, ?integer) \end{TemplatesOneCol} \Description \texttt{atom\_length(Atom, Length)} succeeds if \texttt{Length} unifies with the number of characters of the name of \texttt{Atom}. \begin{PlErrors} \ErrCond{\texttt{Atom} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Length} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Length)} \ErrCond{\texttt{Length} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Length)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{atom\_concat/3}} \begin{TemplatesOneCol} atom\_concat(+atom, +atom, ?atom)\\ atom\_concat(?atom, ?atom, +atom) \end{TemplatesOneCol} \Description \texttt{atom\_concat(Atom1, Atom2, Atom12)} succeeds if the name of \texttt{Atom12} is the concatenation of the name of \texttt{Atom1} with the name of \texttt{Atom1}. This predicate is re-executable on backtracking (e.g. if \texttt{Atom12} is instantiated and both \texttt{Atom1} and \texttt{Atom2} are variables). \begin{PlErrors} \ErrCond{\texttt{Atom1} and \texttt{Atom12} are variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom2} and \texttt{Atom12} are variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom1} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom1)} \ErrCond{\texttt{Atom2} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom2)} \ErrCond{\texttt{Atom12} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom12)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{sub\_atom/5}} \begin{TemplatesOneCol} sub\_atom(+atom, ?integer, ?integer, ?integer, ?atom) \end{TemplatesOneCol} \Description \texttt{sub\_atom(Atom, Before, Length, After, SubAtom)} succeeds if atom \texttt{Atom} can be split into three atoms, \texttt{AtomL}, \texttt{SubAtom} and \texttt{AtomR} such that \texttt{Before} is the number of characters of the name of \texttt{AtomL}, \texttt{Length} is the number of characters of the name of \texttt{SubAtom} and \texttt{After} is the number of characters of the name of \texttt{AtomR}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Atom} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{SubAtom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, SubAtom)} \ErrCond{\texttt{Before} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Before)} \ErrCond{\texttt{Length} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Length)} \ErrCond{\texttt{After} is neither a variable nor an integer} \ErrTerm{type\_error(integer, After)} \ErrCond{\texttt{Before} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Before)} \ErrCond{\texttt{Length} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Length)} \ErrCond{\texttt{After} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, After)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{char\_code/2}\label{char-code/2}} \begin{TemplatesOneCol} char\_code(+character, ?character\_code)\\ char\_code(-character, +character\_code) \end{TemplatesOneCol} \Description \texttt{char\_code(Char, Code)} succeeds if the character code for the one-char atom \texttt{Char} is \texttt{Code}. \begin{PlErrors} \ErrCond{\texttt{Char} and \texttt{Code} are variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char} is neither a variable nor a one-char atom} \ErrTerm{type\_error(character, Char)} \ErrCond{\texttt{Code} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Code)} \ErrCond{\texttt{Code} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{lower\_upper/2}} \begin{TemplatesOneCol} lower\_upper(+character, ?character)\\ lower\_upper(-character, +character) \end{TemplatesOneCol} \Description \texttt{lower\_upper(Char1, Char2)} succeeds if \texttt{Char1} and \texttt{Char2} are one-char atoms and if \texttt{Char2} is the upper conversion of \texttt{Char1}. If \texttt{Char1} (resp. \texttt{Char2}) is a character that is not a lower (resp. upper) letter then \texttt{Char2} is equal to \texttt{Char1}. \begin{PlErrors} \ErrCond{\texttt{Char1} and \texttt{Char2} are variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Char1} is neither a variable nor a one-char atom} \ErrTerm{type\_error(character, Char1)} \ErrCond{\texttt{Char2} is neither a variable nor a one-char atom} \ErrTerm{type\_error(character, Char2)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{atom\_chars/2},\label{atom-chars/2} \IdxPBD{atom\_codes/2}} \begin{TemplatesOneCol} atom\_chars(+atom, ?character\_list)\\ atom\_chars(-atom, +character\_list)\\ atom\_codes(+atom, ?character\_code\_list)\\ atom\_codes(-atom, +character\_code\_list) \end{TemplatesOneCol} \Description \texttt{atom\_chars(Atom, Chars)} succeeds if \texttt{Chars} is the list of one-char atoms whose names are the successive characters of the name of \texttt{Atom}. \texttt{atom\_codes(Atom, Codes)} is similar to \texttt{atom\_chars/2} but deals with a list of character codes. \begin{PlErrors} \ErrCond{\texttt{Atom} is a variable and \texttt{Chars} (or \texttt{Codes}) is a partial list or a list with an element which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Chars} is neither a list nor a partial list} \ErrTerm{type\_error(list, Chars)} \ErrCond{\texttt{Codes} is neither a list nor a partial list} \ErrTerm{type\_error(list, Codes)} \ErrCond{An element \texttt{E} of the list \texttt{Chars} is neither a variable nor a one-char atom} \ErrTerm{type\_error(character, E)} \ErrCond{An element \texttt{E} of the list \texttt{Codes} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{An element \texttt{E} of the list \texttt{Codes} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \end{PlErrors} \Portability ISO predicates. The ISO reference only causes a \texttt{type\_error(list, Chars)} if \texttt{Atom} is a variable and \texttt{Chars} is neither a list nor a partial list. GNU Prolog always checks if \texttt{Chars} is a list. Similarly for \texttt{Codes}. The \texttt{type\_error(integer, E)} when an element \texttt{E} of the \texttt{Codes} is not an integer is a GNU Prolog extension. This seems to be an omission in the ISO reference since this error is detected for many other built-in predicates accepting a character code (e.g. \texttt{char\_code/2}, \texttt{put\_code/2}). \subsubsection{\IdxPBD{number\_atom/2},\label{number-atom/2} \IdxPBD{number\_chars/2}, \IdxPBD{number\_codes/2}} \begin{TemplatesOneCol} number\_atom(+number, ?atom)\\ number\_atom(-number, +atom)\\ number\_chars(+number, ?character\_list)\\ number\_chars(-number, +character\_list)\\ number\_codes(+number, ?character\_code\_list)\\ number\_codes(-number, +character\_code\_list) \end{TemplatesOneCol} \Description \texttt{number\_atom(Number, Atom)} succeeds if \texttt{Atom} is an atom whose name corresponds to the characters of \texttt{Number}. \texttt{number\_chars(Number, Chars)} is similar to \texttt{number\_atom/2} but deals with a list of characters. \texttt{number\_codes(Number, Codes)} is similar to \texttt{number\_atom/2} but deals with a list of character codes. \begin{PlErrors} \ErrCond{\texttt{Number} and \texttt{Atom} are variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Number} is a variable and \texttt{Chars} (or \texttt{Codes}) is a partial list or a list with an element which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Number} is neither a variable nor an number} \ErrTerm{type\_error(number, Number)} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Chars} is neither a list nor a partial list} \ErrTerm{type\_error(list, Chars)} \ErrCond{\texttt{Codes} is neither a list nor a partial list} \ErrTerm{type\_error(list, Codes)} \ErrCond{An element \texttt{E} of the list \texttt{Chars} is neither a variable nor a one-char atom} \ErrTerm{type\_error(character, E)} \ErrCond{An element \texttt{E} of the list \texttt{Codes} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{An element \texttt{E} of the list \texttt{Codes} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \ErrCond{\texttt{Number} is a variable, \texttt{Atom} (or \texttt{Chars} or \texttt{Codes}) cannot be parsed as a number and the value of the \texttt{syntax\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{syntax\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability \texttt{number\_atom/2} is a GNU Prolog predicate. \texttt{number\_chars/2} and \texttt{number\_codes/2} are ISO predicates. GNU Prolog only raises an error about an element \texttt{E} of the \texttt{Chars} (or \texttt{Codes}) list when \texttt{Number} is a variable while the ISO reference always check this. This seems an error since the list itself is only checked if \texttt{Number} is a variable. The \texttt{type\_error(integer, E)} when an element \texttt{E} of the \texttt{Codes} is not an integer is a GNU Prolog extension. This seems to be an omission in the ISO reference since this error is detected for many other built-in predicates accepting a character code (e.g. \texttt{char\_code/2}, \texttt{put\_code/2}). \subsubsection{\IdxPBD{name/2}} \begin{TemplatesOneCol} name(+atomic, ?character\_code\_list)\\ name(-atomic, +character\_code\_list) \end{TemplatesOneCol} \Description \texttt{name(Constant, Codes)} succeeds if \texttt{Codes} is a list whose elements are the character codes corresponding to the successive characters of \texttt{Constant} (a number or an atom). However, there atoms are for which \texttt{name(Constant, Codes)} is true, but which will not be constructed if \texttt{name/2} is called with \texttt{Constant} uninstantiated, e.g. the atom \texttt{'1024'}. For this reason the use of \texttt{name/2} is discouraged and should be limited to compatibility purposes. It is preferable to use atom\_codes/2 \RefSP{atom-chars/2} or number\_chars/2 \RefSP{number-atom/2}. \begin{PlErrors} \ErrCond{\texttt{Constant} is a variable and \texttt{Codes} is a partial list or a list with an element which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Constant} is neither a variable nor an atomic term} \ErrTerm{type\_error(atomic, Constant)} \ErrCond{\texttt{Constant} is a variable and \texttt{Codes} is neither a list nor a partial list} \ErrTerm{type\_error(list, Codes)} \ErrCond{\texttt{Constant} is a variable and an element \texttt{E} of the list \texttt{Codes} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{\texttt{Constant} is a variable and an element \texttt{E} of the list \texttt{Codes} is an integer but not a character code} \ErrTerm{representation\_error(character\_code)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{new\_atom/2}, \IdxPBD{new\_atom/1}} \begin{TemplatesOneCol} new\_atom(+atom, -atom)\\ new\_atom(-atom) \end{TemplatesOneCol} \Description \texttt{new\_atom(Prefix, Atom)} unifies \texttt{Atom} with a new atom whose name begins with the characters of the name of \texttt{Prefix}. This predicate is then a symbol generator. It is guaranteed that \texttt{Atom} does not exist before the invocation of \texttt{new\_atom/3}. The characters appended to \texttt{Prefix} to form \texttt{Atom} are in: \texttt{A}-\texttt{Z} (capital letter), \texttt{a}-\texttt{z} (small letter) and \texttt{0}-\texttt{9} (digit). \texttt{new\_atom/1} is similar to \texttt{new\_atom(term\_, Atom)}, i.e. the generated atom begins with \texttt{term\_}. \begin{PlErrors} \ErrCond{\texttt{Prefix} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Prefix} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Prefix)} \ErrCond{\texttt{Atom} is not a variable} \ErrTerm{uninstantiation\_error(Atom)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{current\_atom/1}\label{current-atom/2}} \begin{TemplatesOneCol} current\_atom(?atom) \end{TemplatesOneCol} \Description \texttt{current\_atom(Atom)} succeeds if there exists an atom that unifies with \texttt{Atom}. All atoms are found except those beginning with a \texttt{'\$'} (system atoms). This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{atom\_property/2}\label{atom-property/2}} \begin{TemplatesOneCol} atom\_property(?atom, ?atom\_property) \end{TemplatesOneCol} \Description \texttt{atom\_property(Atom, Property)} succeeds if \texttt{current\_atom(Atom)} succeeds \RefSP{current-atom/2} and if \texttt{Property} unifies with one of the properties of the atom. This predicate is re-executable on backtracking. \SPart{Atom properties}: \begin{itemize} \item \AddPPD{length}\texttt{length(Length)}: \texttt{Length} is the length of the name of the atom. \item \AddPPD{hash}\texttt{hash(Hash)}: \texttt{Hash} is the \Idx{hash code} of the atom, see also \texttt{term\_hash/2} \RefSP{term-hash/4}. \item \IdxPPD{prefix\_op}: if there is a prefix operator currently defined with this name. \item \IdxPPD{infix\_op}: if there is an infix operator currently defined with this name. \item \IdxPPD{postfix\_op}: if there is a postfix operator currently defined with this name. \item \IdxPPD{needs\_quotes}: if the atom must be quoted to be read later. \item \IdxPPD{needs\_scan}: if the atom must be scanned when output to be read later (e.g. contains special characters that must be output with a \texttt{{\bs}} \Idx{escape sequence}). \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Atom} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Atom)} \ErrCond{\texttt{Property} is neither a variable nor a n atom property term} \ErrTerm{domain\_error(atom\_property, Property)} \ErrCond{\texttt{Property} = \texttt{length(E)} or \texttt{hash(E)} and \texttt{E} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{List processing} These predicates manipulate lists. They are bootstrapped predicates (i.e. written in Prolog) and no error cases are tested (for the moment). However, since they are written in Prolog using other built-in predicates, some errors can occur due to those built-in predicates. \subsubsection{\IdxPBD{append/3}} \begin{TemplatesOneCol} append(?list, ?list, ?list) \end{TemplatesOneCol} \Description \texttt{append(List1, List2, List12)} succeeds if the concatenation of the list \texttt{List1} and the list \texttt{List2} is the list \texttt{List12}. This predicate is re-executable on backtracking (e.g. if \texttt{List12} is instantiated and both \texttt{List1} and \texttt{List2} are variable). \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{member/2}, \label{member/2} \IdxPBD{memberchk/2}} \begin{TemplatesOneCol} member(?term, ?list)\\ memberchk(?term, ?list) \end{TemplatesOneCol} \Description \texttt{member(Element, List)} succeeds if \texttt{Element} belongs to the \texttt{List}. This predicate is re-executable on backtracking and can be thus used to enumerate the elements of \texttt{List}. \texttt{memberchk/2} is similar to \texttt{member/2} but only succeeds once. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{reverse/2}} \begin{TemplatesOneCol} reverse(?list, ?list) \end{TemplatesOneCol} \Description \texttt{reverse(List1, List2)} succeeds if \texttt{List2} unifies with the list \texttt{List1} in reverse order. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{delete/3}, \IdxPBD{select/3}} \begin{TemplatesOneCol} delete(?list, ?term, ?list)\\ select(?term, ?list, ?list) \end{TemplatesOneCol} \Description \texttt{delete(List1, Element, List2)} removes all occurrences of \texttt{Element} in \texttt{List1} to provide \texttt{List2}. A strict term equality is required, cf. \IdxPB{(==)/2} \RefSP{(==)/2}. \texttt{select(Element, List1, List2)} removes one occurrence of \texttt{Element} in \texttt{List1} to provide \texttt{List2}. This predicate is re-executable on backtracking. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{subtract/3}} \begin{TemplatesOneCol} subtract(+list, +list, ?list) \end{TemplatesOneCol} \Description \texttt{subtract(List1, List2, List3)} removes all elements in \texttt{List2} from \texttt{List1} to provide \texttt{List3}. Membership is tested using \texttt{memberchk/2} \RefSP{member/2}. The predicate runs in $O(|\texttt{List2}| \times |\texttt{List1}|)$. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{permutation/2}} \begin{TemplatesOneCol} permutation(?list, ?list) \end{TemplatesOneCol} \Description \texttt{permutation(List1, List2)} succeeds if \texttt{List2} is a permutation of the elements of \texttt{List1}. This predicate is re-executable on backtracking. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{prefix/2}, \IdxPBD{suffix/2}} \begin{TemplatesOneCol} prefix(?list, ?list)\\ suffix(?list, ?list) \end{TemplatesOneCol} \Description \texttt{prefix(Prefix, List)} succeeds if \texttt{Prefix} is a prefix of \texttt{List}. This predicate is re-executable on backtracking. \texttt{suffix(Suffix, List)} succeeds if \texttt{Suffix} is a suffix of \texttt{List}. This predicate is re-executable on backtracking. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{sublist/2}} \begin{TemplatesOneCol} sublist(?list, ?list) \end{TemplatesOneCol} \Description \texttt{sublist(List1, List2)} succeeds if all elements of \texttt{List1} appear in \texttt{List2} in the same order. This predicate is re-executable on backtracking. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{last/2}} \begin{TemplatesOneCol} last(?list, ?term) \end{TemplatesOneCol} \Description \texttt{last(List, Element)} succeeds if \texttt{Element} is the last element of \texttt{List}. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{flatten/2}} \begin{TemplatesOneCol} flatten(?term, ?list) \end{TemplatesOneCol} \Description \texttt{flat(List1, List2)} succeeds if \texttt{List2} is the flatten version of \texttt{List1}. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{length/2}} \begin{TemplatesOneCol} length(?list, ?integer) \end{TemplatesOneCol} \Description \texttt{length(List, Length)} succeeds if \texttt{Length} is the length of \texttt{List}. \begin{PlErrors} \ErrCond{\texttt{Length} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Length)} \end{PlErrors} GNU Prolog predicate. \subsubsection{\IdxPBD{nth/3}} \begin{TemplatesOneCol} nth(?integer, ?list, ?term) \end{TemplatesOneCol} \Description \texttt{nth(N, List, Element)} succeeds if the \texttt{N}\emph{th} argument of \texttt{List} is \texttt{Element}. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{max\_list/2}, \IdxPBD{min\_list/2}, \IdxPBD{sum\_list/2}} \begin{TemplatesOneCol} min\_list(+list, ?number)\\ max\_list(+list, ?number)\\ sum\_list(+list, ?number) \end{TemplatesOneCol} \Description \texttt{min\_list(List, Min)} succeeds if \texttt{Min} is the smallest number in \texttt{List}. \texttt{max\_list(List, Max)} succeeds if \texttt{Max} is the largest number in \texttt{List}. \texttt{sum\_list(List, Sum)} succeeds if \texttt{Sum} is the sum of all the elements in \texttt{List}. \texttt{List} must be a list of arithmetic evaluable terms \RefSP{Evaluation-of-an-arithmetic-expression}. \PlErrorsNone \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{maplist/2-8}} \begin{TemplatesOneCol} maplist(+callable\_term, +list, \ldots, +list) \end{TemplatesOneCol} \Description \texttt{maplist(Goal, List)} succeeds if \texttt{Goal} can succesfully be applied on all elements of \texttt{List}. \texttt{maplist(Goal, List1, List2)} succeeds if \texttt{Goal} can succesfully be applied to all pairs of elements of \texttt{List1} and \texttt{List2}. \texttt{maplist(Goal, List1, List2, List3)} succeeds if \texttt{Goal} can succesfully be applied to all triples of elements of \texttt{List1}..\texttt{List3}. \texttt{maplist(Goal, List1, List2, \ldots, List$N$)} succeeds if \texttt{Goal} can succesfully be applied to all $N$-uples ($N \leq 8$) of elements of \texttt{List1}..\texttt{List$N$}. \begin{PlErrors} \ErrCond{an error occurs executing a directive} \ErrTermRm{see \texttt{call/1} errors \RefSP{call/1}} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{sort/2},\label{sort/2} \IdxPBD{msort/2}, \IdxPBD{keysort/2} \IdxPBD{sort/1}, \IdxPBD{msort/1}, \IdxPBD{keysort/1}} \begin{TemplatesOneCol} sort(+list, ?list)\\ msort(+list, ?list)\\ keysort(+list, ?list)\\ sort(+list)\\ msort(+list)\\ keysort(+list) \end{TemplatesOneCol} \Description \texttt{sort(List1, List2)} succeeds if \texttt{List2} is the sorted list corresponding to \texttt{List1} where duplicate elements are merged. \texttt{msort/2} is similar to \texttt{sort/2} except that duplicate elements are not merged. \texttt{keysort(List1, List2)} succeeds if \texttt{List2} is the sorted list of \texttt{List1} according to the keys. The list \texttt{List1} consists of pairs (items of the form \texttt{Key-Value}). These items are sorted according to the value of \texttt{Key} yielding the \texttt{List2}. Duplicate keys are not merged. This predicate is stable, i.e. if \texttt{K-A} occurs before \texttt{K-B} in the input, then \texttt{K-A} will occur before \texttt{K-B} in the output. \texttt{sort/1}, \texttt{msort/1} and \texttt{keysort/1} are similar to \texttt{sort/2}, \texttt{msort/2} and \texttt{keysort/2} but achieve a sort in-place destructing the original \texttt{List1} (this in-place assignment is not undone at backtracking). The sorted list occupies the same memory space as the original list (saving thus memory consumption). The time complexity of these sorts is $O(N~log~N)$, $N$ being the length of the list to sort. These predicates refer to the standard ordering of terms \RefSP{Standard-total-ordering-of-terms}. \begin{PlErrors} \ErrCond{\texttt{List1} is a partial list} \ErrTerm{instantiation\_error} \ErrCond{\texttt{List1} is neither a partial list nor a list} \ErrTerm{type\_error(list, List1)} \ErrCond{\texttt{List2} is neither a partial list nor a list} \ErrTerm{type\_error(list, List2)} \ErrCond{for \texttt{keysort/2}: an element of \texttt{List1} is a variable} \ErrTerm{instantiation\_error} \ErrCond{for \texttt{keysort/2}: an element \texttt{E} of \texttt{List1} is neither a variable nor a pair} \ErrTerm{type\_error(pair, E)} \ErrCond{for \texttt{keysort/2}: an element \texttt{E} of \texttt{List2} is neither a variable nor a pair} \ErrTerm{type\_error(pair, E)} \end{PlErrors} \Portability \texttt{sort/2} and \texttt{keysort/2} are ISO predicates. \texttt{sort/1}, \texttt{keysort/1} and \texttt{msort/1-2} are GNU Prolog predicates. \subsection{Global variables} \subsubsection{Introduction} \label{Global-variables} GNU Prolog provides a simple and powerful way to assign and read global variables. A global variable is associated with each atom, its initial value is the integer 0. A global variable can store 3 kinds of objects: \begin{itemize} \item a copy of a term (the assignment can be made backtrackable or not). \item a link to a term (the assignment is always backtrackable). \item an array of objects (recursively). \end{itemize} The space necessary for copies and arrays is dynamically allocated and recovered as soon as possible. For instance, when an atom is associated with a global variable whose current value is an array, the space for this array is recovered (unless the assignment is to be undone when backtracking occurs). When a link to a term is associated with a global variable, the reference to this term is stored and thus the original term is returned when the content of the variable is read. \SPart{Global variable naming convention}: a global variable is referenced by an atom. If the variable contains an array, an index (ranging from 0) can be provided using a compound term whose principal functor is the corresponding atom and the argument is the index. In case of a multi-dimensional array, each index is given as the arguments of the compound term. If the variable contains a term (link or copy), it is possible to only reference a sub-term by giving its argument number (also called \IdxD{argument selector}). Such a sub-term is specified using a compound term whose principal functor is \texttt{-/2} and whose first argument is a global variable name and the second argument is the argument number (from 1). This can be applied recursively to specify a sub-term of any depth. In case of a list, a argument number I represents the Ith element of the list. In the rest of this section we use the operator notation since \texttt{-} is a predefined infix operator \RefSP{op/3:(Term-input/output)}. In the following, \Param{GVarName} represents a reference to a global variable and its syntax is as follows: \begin{Indentation} \begin{tabular}{@{}llll} \Param{GVarName} & ::= & \Param{atom} & whole content of a variable \\ & & \Param{atom}\texttt{(}\Param{Integer}\texttt{,}\ldots\texttt{,}\Param{Integer}\texttt{)} & element of an array \\ & & \Param{GVarName}\texttt{-}\Param{Integer} & sub-term selection \\ \Param{Integer} & ::= & \Param{integer} & immediate value \\ & & \Param{GVarName} & indirect value \end{tabular} \end{Indentation} When a \Param{GVarName} is used as an index or an argument number (i.e. indirection), the value of this variable must be an integer. Here are some examples of the naming convention: \begin{tabular}{ll} \texttt{a} & the content of variable associated with \texttt{a} (any kind) \\ \texttt{t(1)} & the 2nd element of the array associated with \texttt{t} \\ \texttt{t(k)} & if the value associated with \texttt{k} is I, the Ith element of the array associated with \texttt{t} \\ \texttt{a-1-2} & if the value associated with \texttt{a} is \texttt{f(g(a,b,c),2)}, the sub-term \texttt{b} \\ \end{tabular} Here are the errors associated with global variable names and common to all predicates. \begin{PlErrorsNoTitle} \ErrCond{\texttt{GVarName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{GVarName} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, GVarName)} \ErrCond{\texttt{GVarName} contains an invalid argument number (or \texttt{GVarName} is an array)} \ErrTerm{domain\_error(g\_argument\_selector, GVarName)} \ErrCond{\texttt{GVarName} contains an invalid index (or \texttt{GVarName} is not an array)} \ErrTerm{domain\_error(g\_array\_index, GVarName)} \ErrCond{\texttt{GVarName} is used as an indirect index or argument selector and is not an integer} \ErrTerm{type\_error(integer, GVarName)} \end{PlErrorsNoTitle} \SPart{Arrays}: the predicates \texttt{g\_assign/2}, \texttt{g\_assignb/2} and \texttt{g\_link/2} \RefSP{g-assign/2} can be used to create an array. They recognize some terms as values. For instance, a compound term with principal functor \IdxPGD{g\_array} is used to define an array of fixed size. There are 3 forms for the term \texttt{g\_array}: \begin{itemize} \item \texttt{g\_array(Size)}: if \texttt{Size} is an integer $>$ 0 then defines an array of \texttt{Size} elements which are all initialized with the integer \texttt{0}. \item \texttt{g\_array(Size, Initial)}: as above but the elements are initialized with the term \texttt{Initial} instead of 0. \texttt{Initial} can contain other array definitions allowing thus for multi-dimensional arrays. \item \texttt{g\_array(List)}: as above if \texttt{List} is a list of length \texttt{Size} except that the elements of the array are initialized according to the elements of \texttt{List} (which can contain other array definitions). \end{itemize} An array can be extended explicitly using a compound term with principal functor \IdxPGD{g\_array\_extend} which accept the same 3 forms detailed above. In that case, the existing elements of the array are not initialized. If \texttt{g\_array\_extend} is used with an object which is not an array it is similar to \texttt{g\_array}. Finally, an array can be \textit{automatically} expanded when needed. The programmer does not need to explicitly control the expansion of an automatic array. An array is expanded as soon as an index is outside the current size of this array. Such an array is defined using a compound term with principal functor \IdxPGD{g\_array\_auto}: \begin{itemize} \item \texttt{g\_array\_auto(Size)}: if \texttt{Size} is an integer $>$ 0 then defines an automatic array whose initial size is \texttt{Size}. All elements are initialized with the integer \texttt{0}. Elements created during implicit expansions will be initialized with \texttt{0}. \item \texttt{g\_array\_auto(Size, Initial)}: as above but the elements are initialized with the term \texttt{Initial} instead of 0. \texttt{Initial} can contain other array definitions allowing thus for multi-dimensional arrays. Elements created during implicit expansions will be initialized with \texttt{Initial}. \item \texttt{g\_array\_auto(List)}: as above if \texttt{List} is a list of length \texttt{Size} except that the elements of the array are initialized according to the elements of \texttt{List} (which can contain other array definitions). Elements created during implicit expansions will be initialized with \texttt{0}. \end{itemize} In any case, when an array is read, a term of the form \texttt{g\_array([Elem0,..., ElemSize-1])} is returned. Some examples using global variables are presented later \RefSP{Examples}. \subsubsection{\IdxPBD{g\_assign/2},\label{g-assign/2} \IdxPBD{g\_assignb/2}, \IdxPBD{g\_link/2}} \begin{TemplatesOneCol} g\_assign(+callable\_term, ?term)\\ g\_assignb(+callable\_term, ?term)\\ g\_link(+callable\_term, ?term) \end{TemplatesOneCol} \Description \texttt{g\_assign(GVarName, Value)} assigns a copy of the term \texttt{Value} to \texttt{GVarName}. This assignment is not undone when backtracking occurs. \texttt{g\_assignb/2} is similar to \texttt{g\_assign/2} but the assignment is undone at backtracking. \texttt{g\_link(GVarName, Value)} makes a link between \texttt{GVarName} to the term \texttt{Value}. This allows the user to give a name to any Prolog term (in particular non-ground terms). Such an assignment is always undone when backtracking occurs (since the term may no longer exist). If \texttt{Value} is an atom or an integer, \texttt{g\_link/2} and \texttt{g\_assignb/2} have the same behavior. Since \texttt{g\_link/2} only handles links to existing terms it does not require extra memory space and is not expensive in terms of execution time. NB: argument selectors can only be used with {g\_assign/2} (i.e. when using an argument selector inside an assignment, this one must not be backtrackable). \Errors See common errors detailed in the introduction \RefSP{Global-variables} \begin{PlErrorsNoTitle} \ErrCond{\texttt{GVarName} contains an argument selector and the assignment is backtrackable} \ErrTerm{domain\_error(g\_argument\_selector, GVarName)} \end{PlErrorsNoTitle} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{g\_read/2}} \begin{TemplatesOneCol} g\_read(+callable\_term, ?term) \end{TemplatesOneCol} \Description \texttt{g\_read(GVarName, Value)} unifies \texttt{Value} with the term assigned to \texttt{GVarName}. \Errors See common errors detailed in the introduction \RefSP{Global-variables} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{g\_array\_size/2}} \begin{TemplatesOneCol} g\_array\_size(+callable\_term, ?integer) \end{TemplatesOneCol} \Description \texttt{g\_array\_size(GVarName, Value)} unifies \texttt{Size} with the dimension (an integer $>$ 0) of the array assigned to \texttt{GVarName}. Fails if \texttt{GVarName} is not an array. \Errors See common errors detailed in the introduction \RefSP{Global-variables} \begin{PlErrorsNoTitle} \ErrCond{\texttt{Size} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Size)} \end{PlErrorsNoTitle} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{g\_inc/3}, \IdxPBD{g\_inc/2}, \IdxPBD{g\_inco/2}, \IdxPBD{g\_inc/1}, \IdxPBD{g\_dec/3}, \IdxPBD{g\_dec/2}, \IdxPBD{g\_deco/2}, \IdxPBD{g\_dec/1}} \begin{TemplatesOneCol} g\_inc(+callable\_term, ?integer, ?integer) \\ g\_inc(+callable\_term, ?integer) \\ g\_inco(+callable\_term, ?integer) \\ g\_inc(+callable\_term) \\ g\_dec(+callable\_term, ?integer, ?integer) \\ g\_dec(+callable\_term, ?integer) \\ g\_deco(+callable\_term, ?integer) \\ g\_dec(+callable\_term) \end{TemplatesOneCol} \Description \texttt{g\_inc(GVarName, Old, New)} unifies \texttt{Old} with the integer assigned to \texttt{GVarName}, increments \texttt{GVarName} and then unifies \texttt{New} with the incremented value. \texttt{g\_inc(GVarName, New)} is equivalent to \texttt{g\_inc(GVarName, \_, New)}. \texttt{g\_inco(GVarName, Old)} is equivalent to \texttt{g\_inc(GVarName, Old, \_)}. \texttt{g\_inc(GVarName)} is equivalent to \texttt{g\_inc(GVarName, \_, \_)}. Predicates \texttt{g\_dec} are similar but decrement the content of \texttt{GVarName} instead. \Errors See common errors detailed in the introduction \RefSP{Global-variables} \begin{PlErrorsNoTitle} \ErrCond{\texttt{Old} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Old)} \ErrCond{\texttt{New} is neither a variable nor an integer} \ErrTerm{type\_error(integer, New)} \ErrCond{\texttt{GVarName} stores an array} \ErrTerm{type\_error(integer, g\_array)} \ErrCond{\texttt{GVarName} stores a term \texttt{T} which is not an integer} \ErrTerm{type\_error(integer, T)} \end{PlErrorsNoTitle} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{g\_set\_bit/2}, \IdxPBD{g\_reset\_bit/2}, \IdxPBD{g\_test\_set\_bit/2}, \IdxPBD{g\_test\_reset\_bit/2}} \begin{TemplatesOneCol} g\_set\_bit(+callable\_term, +integer) \\ g\_reset\_bit(+callable\_term, +integer) \\ g\_test\_set\_bit(+callable\_term, +integer) \\ g\_test\_reset\_bit(+callable\_term, +integer) \end{TemplatesOneCol} \Description \texttt{g\_set\_bit(GVarName, Bit)} sets to 1 the bit number specified by \texttt{Bit} of the integer assigned to \texttt{GVarName} to 1. Bit numbers range from 0 to the maximum number allowed for integers (this is architecture dependent). If \texttt{Bit} is greater than this limit, the modulo with this limit is taken. \texttt{g\_reset\_bit(GVarName, Bit)} is similar to \texttt{g\_set\_bit/2} but sets the specified bit to 0. \texttt{g\_test\_set\_bit/2} succeeds if the specified bit is set to 1. \texttt{g\_test\_reset\_bit/2} succeeds if the specified bit is set to 0. \Errors See common errors detailed in the introduction \RefSP{Global-variables} \begin{PlErrorsNoTitle} \ErrCond{\texttt{Bit} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Bit} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Bit)} \ErrCond{\texttt{Bit} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Bit)} \ErrCond{\texttt{GVarName} stores an array} \ErrTerm{type\_error(integer, g\_array)} \ErrCond{\texttt{GVarName} stores a term \texttt{T} which is not an integer} \ErrTerm{type\_error(integer, T)} \end{PlErrorsNoTitle} \Portability GNU Prolog predicates. \subsubsection{Examples} \label{Examples} \SPart{Simulating \texttt{g\_inc/3}}: this predicate behaves like: global variable: \begin{Indentation} \begin{verbatim} my_g_inc(Var, Old, New) :- g_read(Var, Old), N is Value + 1, g_assign(Var, X), New = N. \end{verbatim} \end{Indentation} The query: \texttt{my\_g\_inc(c, X, \_)} will succeed unifying \texttt{X} with \texttt{0}, another call to \texttt{my\_g\_inc(a, Y, \_)} will then unify \texttt{Y} with \texttt{1}, and so on. \SPart{Difference between \texttt{g\_assign/2} and \texttt{g\_assignb/2}}: \texttt{g\_assign/2} does not undo its assignment when backtracking occurs whereas \texttt{g\_assignb/2} undoes it. \begin{Code} \begin{tabular}{@{}p{6cm}@{\quad}l@{}} test(Old) :- & testb(Old) :- \\ ~~~~~~~~g\_assign(x,1), & ~~~~~~~~g\_assign(x,1), \\ ~~~~~~~~(~~~g\_read(x, Old), & ~~~~~~~~(~~~g\_read(x, Old), \\ ~~~~~~~~~~~~\textit{g\_assign}(x, 2) & ~~~~~~~~~~~~\textit{g\_assignb}(x, 2) \\ ~~~~~~~~;~~~g\_read(x,~Old), & ~~~~~~~~;~~~g\_read(x, Old), \\ ~~~~~~~~~~~~g\_assign(x, 3) & ~~~~~~~~~~~~g\_assign(x, 3) \\ ~~~~~~~~). & ~~~~~~~~). \\ \end{tabular} \end{Code} The query \texttt{test(Old)} will succeed unifying \texttt{Old} with \texttt{1} and on backtracking with \texttt{2} (i.e. the assignment of the value \texttt{2} has not been undone). The query \texttt{testb(Old)} will succeed unifying \texttt{Old} with \texttt{1} and on backtracking with \texttt{1} (i.e. the assignment of the value \texttt{2} has been undone). \SPart{Difference between \texttt{g\_assign/2} and \texttt{g\_link/2}}: \texttt{g\_assign/2} (and \texttt{g\_assignb/2}) creates a copy of the term whereas \texttt{g\_link/2} does not. \texttt{g\_link/2} can be used to avoid passing big data structures (e.g. dictionaries,\ldots) as arguments to predicates. \begin{Code} \begin{tabular}{@{}p{6cm}@{\quad}l@{}} test(B) :- & test(B) :- \\ ~~~~~~~~\textit{g\_assign}(b, f(X)), & ~~~~~~~~\textit{g\_link}(b, f(X)), \\ ~~~~~~~~X = 12, & ~~~~~~~~X = 12, \\ ~~~~~~~~g\_read(b, B). & ~~~~~~~~g\_read(b, B). \\ \end{tabular} \end{Code} The query \texttt{test(B)} will succeed unifying \texttt{B} with \texttt{f(\_)} (\texttt{g\_assign/2} assigns a copy of the value). The query \texttt{test(B)} will succeed unifying \texttt{B} with \texttt{f(12)} (\texttt{g\_link/2} assigns a pointer to the term). \SPart{Simple array definition}: here are some queries to show how arrays can be handled: \begin{Indentation} \begin{verbatim} | ?- g_assign(w, g_array(3)), g_read(w, X). X = g_array([0,0,0]) | ?- g_assign(w(0), 16), g_assign(w(1), 32), g_assign(w(2), 64), g_read(w, X). X = g_array([16,32,64]) \end{verbatim} \end{Indentation} this is equivalent to: \begin{Indentation} \begin{verbatim} | ?- g_assign(k, g_array([16,32,64])), g_read(k, X). X = g_array([16,32,64]) | ?- g_assign(k, g_array(3,null)), g_read(k, X), g_array_size(k, S). S = 3 X = g_array([null,null,null]) \end{verbatim} \end{Indentation} \SPart{2-D array definition}: \begin{Indentation} \begin{verbatim} | ?- g_assign(w, g_array(2, g_array(3))), g_read(w, X). X = g_array([g_array([0,0,0]),g_array([0,0,0])]) | ?- ( for(I,0,1), for(J,0,2), K is I*3+J, g_assign(w(I,J), K), fail ; g_read(w, X) ). X = g_array([g_array([0,1,2]),g_array([3,4,5])]) | ?- g_read(w(1),X). X = g_array([3,4,5]) \end{verbatim} \end{Indentation} \SPart{Hybrid array}: \begin{Indentation} \begin{verbatim} | ?- g_assign(w,g_array([1,2,g_array([a,b,c]), g_array(2,z),5])), g_read(w, X). X = g_array([1,2,g_array([a,b,c]), g_array([z,z]),5]) | ?- g_read(w(1), X), g_read(w(2,1), Y), g_read(w(3,1), Z). X = 2 Y = b Z = z | ?- g_read(w(1,2),X). uncaught exception: error(domain_error(g_array_index,w(1,2)),g_read/2) \end{verbatim} \end{Indentation} \SPart{Array extension}: \begin{Indentation} \begin{verbatim} | ?- g_assign(a, g_array([10,20,30])), g_read(a, X). X = g_array([10,20,30]) | ?- g_assign(a, g_array_extend(5,null)), g_read(a, X). X = g_array([10,20,30,null,null]) | ?- g_assign(a, g_array([10,20,30])), g_read(a, X). X = g_array([10,20,30]) | ?- g_assign(a, g_array_extend([1,2,3,4,5,6])), g_read(a, X). X = g_array([10,20,30,4,5,6]) \end{verbatim} \end{Indentation} \SPart{Automatic array}: \begin{Indentation} \begin{verbatim} | ?- g_assign(t, g_array_auto(3)), g_assign(t(1), foo), g_read(t,X). X = g_array([0,foo,0]) | ?- g_assign(t(5), bar), g_read(t,X). X = g_array([0,foo,0,0,0,bar,0,0]) | ?- g_assign(t, g_array_auto(2, g_array(2))), g_assign(t(1,1), foo), g_read(t,X). X = g_array([g_array([0,0]),g_array([0,foo])]) | ?- g_assign(t(3,0), bar), g_read(t,X). X = g_array([g_array([0,0]),g_array([0,foo]),g_array([0,0]),g_array([bar,0])]) | ?- g_assign(t(3,4), bar), g_read(t,X). uncaught exception: error(domain_error(g_array_index,t(3,4)),g_assign/2) | ?- g_assign(t, g_array_auto(2, g_array_auto(2))), g_assign(t(1,1), foo), g_read(t,X). X = g_array([g_array([0,0]),g_array([0,foo])]) | ?- g_assign(t(3,3), bar), g_read(t,X). X = g_array([g_array([0,0]),g_array([0,foo]),g_array([0,0]), g_array([0,0,0,bar])]) | ?- g_assign(t, g_array_auto(2, g_array_auto(2, null))), g_read(t(2,3), U), g_read(t, X). U = null X = g_array([g_array([null,null]),g_array([null,null]), g_array([null,null,null,null]),g_array([null,null])]) \end{verbatim} \end{Indentation} \subsection{Prolog state} \subsubsection{\IdxPBD{set\_prolog\_flag/2}\label{set-prolog-flag/2}} \begin{TemplatesOneCol} set\_prolog\_flag(+flag, +term) \end{TemplatesOneCol} \Description \texttt{set\_prolog\_flag(Flag, Value)} sets the value of the \IdxD{Prolog flag} \texttt{Flag} to \texttt{Value}. \index{flag|see {Prolog flag}} \SPart{Prolog flags}: a Prolog flag is an atom which is associated with a value that is either implementation defined or defined by the user. Each flag has a permitted range of values; any other value is a \texttt{domain\_error}. The following two tables present available flags, the possible values, a description and if they are ISO or an extension. The first table presents unchangeable flags while the second one the changeable flags. For flags whose default values is machine independent, this value is \underline{underlined}. \SPart{Unchangeable flags}: \begin{tabular}{|L{4.5cm}|C{2.2cm}|L{6.5cm}|C{0,6cm}|} \hline Flag & Values & Description & ISO \\ \hline\hline \IdxPFD{prolog\_name} & an atom & name of the Prolog system & N \\ \hline \IdxPFD{prolog\_version} & an atom & version number of the Prolog system & N \\ \hline \IdxPFD{prolog\_date} & an atom & date of the Prolog system & N \\ \hline \IdxPFD{prolog\_copyright} & an atom & copyright message of the Prolog system & N \\ \hline \IdxPFD{dialect} & an atom & fixed to \texttt{gprolog} & N \\ \hline \IdxPFD{version} & an integer & $Major * 10000 + Minor * 100 + Patch$ & N \\ \hline \IdxPFD{version\_data} & a structure & \texttt{gprolog(Major,Minor,Patch,Extra)} & N \\ \hline \IdxPFD{bounded} & \texttt{\underline{true}} / \texttt{false} & are integers bounded ? & Y \\ \hline \IdxPFD{max\_integer} & an integer & greatest integer & Y \\ \hline \IdxPFD{min\_integer} & an integer & smallest integer & Y \\ \hline \IdxPFD{integer\_rounding\_function} & \texttt{toward\_zero} \linebreak \texttt{down} & \texttt{\textit{rnd}(X)} = integer part of \texttt{X} \linebreak \texttt{\textit{rnd}(X)} = $\lfloor$\texttt{X$\rfloor$} \RefSP{Evaluation-of-an-arithmetic-expression} & Y \\ \hline \IdxPFD{max\_arity} & an integer & maximum arity for compound terms (255) & Y \\ \hline \IdxPFD{max\_atom} & an integer & maximum number of atoms & N \\ \hline \IdxPFD{max\_unget} & an integer & maximum number of successive ungets & N \\ \hline \IdxPFD{home} & an atom & GNU Prolog home directory & N \\ \hline \IdxPFD{host\_os} & an atom & Operating System identifier & N \\ \hline \IdxPFD{host\_vendor} & an atom & Operating System vendor & N \\ \hline \IdxPFD{host\_cpu} & an atom & processor identifier & N \\ \hline \IdxPFD{host} & an atom & a combination of the OS-vendor-cpu & N \\ \hline \IdxPFD{arch} & an atom & a combination of the OS-cpu & N \\ \hline \IdxPFD{address\_bits} & an integer & address size of the machine (32 or 64) & N \\ \hline \IdxPFD{unix} & \texttt{on}/\texttt{off} & is the architecture an Unix-like OS ? & N \\ \hline \IdxPFD{compiled\_at} & an atom & compilation date using \texttt{\_\_DATE\_\_} and \texttt{\_\_TIME\_\_} C compiler macros & N \\ \hline \IdxPFD{c\_cc} & an atom & C compiler used to compile GNU Prolog (\texttt{gcc}, \texttt{cc}, \texttt{clang}, \texttt{cl},...) & N \\ \hline \IdxPFD{c\_cc\_version\_data} & a structure & \texttt{\textit{c\_cc}(Major,Minor,Patch,Extra)} & N \\ \hline \IdxPFD{c\_cflags} & an atom & \texttt{CFLAGS} used to compile GNU Prolog & N \\ \hline \IdxPFD{c\_ldflags} & an atom & \texttt{LDFLAGS} used to compile GNU Prolog & N \\ \hline \IdxPFD{argv} & a list of atoms & list of command-line arguments & N \\ \hline \end{tabular} \SPart{Changeable flags}: \begin{tabular}{|L{4.5cm}|C{2.8cm}|L{6.2cm}|C{0,6cm}|} \hline Flag & Values & Description & ISO \\ \hline\hline \IdxPFD{char\_conversion} & \texttt{on} / \texttt{\underline{off}} & is character conversion activated ? & Y \\ \hline \IdxPFD{singleton\_warning} & \texttt{\underline{on}} / \texttt{off} & warn about named singleton variables ? & N \\ \hline \IdxPFD{suspicious\_warning} & \texttt{\underline{on}} / \texttt{off} & warn about suspicious predicate ? & N \\ \hline \IdxPFD{multifile\_warning} & \texttt{\underline{on}} / \texttt{off} & warn about unsupported multifile directive ? & N \\ \hline \IdxPFD{strict\_iso} & \texttt{\underline{on}} / \texttt{off} & strict ISO behavior ? & N \\ \hline \IdxPFD{debug} & \texttt{on} / \texttt{\underline{off}} & is the debugger activated ? & Y \\ \hline ~ \linebreak \IdxPFD{double\_quotes} & ~ \linebreak \texttt{atom} \linebreak \texttt{chars} \linebreak \texttt{\underline{codes}} \linebreak \texttt{atom\_no\_escape} \linebreak \texttt{chars\_no\_escape} \linebreak \texttt{codes\_no\_escape} & a double quoted constant is returned as: \linebreak an atom \linebreak a list of characters \linebreak a list of character codes \linebreak as \texttt{atom} but ignore \IdxD{escape sequence}s \linebreak as \texttt{chars} but ignore escape sequences \linebreak as \texttt{code} but ignore escape sequences & ~ \linebreak Y \linebreak ~ \linebreak ~ \linebreak N \\ \hline ~ \linebreak \IdxPFD{back\_quotes} & ~ \linebreak \texttt{atom} \linebreak \texttt{chars} \linebreak \texttt{codes} \linebreak \texttt{\underline{atom\_no\_escape}} \linebreak \texttt{chars\_no\_escape} \linebreak \texttt{codes\_no\_escape} & a back quoted constant is returned as: \linebreak an atom \linebreak a list of characters \linebreak a list of character codes \linebreak as \texttt{atom} but ignore escape sequences \linebreak as \texttt{chars} but ignore escape sequences \linebreak as \texttt{code} but ignore escape sequences & ~ \linebreak N \\ \hline ~ \linebreak \IdxPFD{unknown} & ~ \linebreak \texttt{\underline{error}} \linebreak \texttt{warning} \linebreak \texttt{fail} & a predicate calls an unknown procedure: \linebreak an \texttt{existence\_error} is raised \linebreak a message is displayed then fails \linebreak quietly fails & ~ \linebreak Y \\ \hline ~ \linebreak \IdxPFD{syntax\_error} & ~ \linebreak \texttt{\underline{error}} \linebreak \texttt{warning} \linebreak \texttt{fail} & a predicate causes a syntax error: \linebreak a \texttt{syntax\_error} is raised \linebreak a message is displayed then fails \linebreak quietly fails & ~ \linebreak N \\ \hline ~ \linebreak \IdxPFD{os\_error} & ~ \linebreak \texttt{\underline{error}} \linebreak \texttt{warning} \linebreak \texttt{fail} & a predicate causes an O.S. error: \linebreak a \texttt{system\_error} is raised \linebreak a message is displayed then fails \linebreak quietly fails & ~ \linebreak N \\ \hline \end{tabular} The \texttt{strict\_iso} flag is introduced to allow a compatibility with other Prolog systems. When turned off the following relaxations apply: \begin{itemize} \item built-in predicates are found by \texttt{current\_predicate/1} \RefSP{current-predicate/1}. \item the term parser (\texttt{read/1} and friends) is more indulgent, e.g. \texttt{0''} is accepted and returns 39, the \Idx{escape sequence} \texttt{{\bs}s} (space) and \texttt{{\bs}e} (escape) are accepted. \item the following arithmetic rounding functions: \texttt{ceiling}, \texttt{floor}, \texttt{round}, \texttt{truncate} also accept integers \RefSP{Evaluation-of-an-arithmetic-expression}. \end{itemize} \begin{PlErrors} \ErrCond{\texttt{Flag} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Value} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Flag} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Flag)} \ErrCond{\texttt{Flag} is an atom but not a valid flag} \ErrTerm{domain\_error(prolog\_flag, Flag)} \ErrCond{\texttt{Value} is inappropriate for Flag} \ErrTerm{domain\_error(flag\_value, Flag+Value)} \ErrCond{\texttt{Value} is appropriate for \texttt{Flag} but flag \texttt{Flag} is not modifiable} \ErrTerm{permission\_error(modify, flag, Flag)} \end{PlErrors} \Portability ISO predicate. All ISO flags are implemented. \subsubsection{\IdxPBD{current\_prolog\_flag/2}\label{current-prolog-flag/2}} \begin{TemplatesOneCol} current\_prolog\_flag(?flag, ?term) \end{TemplatesOneCol} \Description \texttt{current\_prolog\_flag(Flag, Value)} succeeds if there exists a \Idx{Prolog flag} that unifies with \texttt{Flag} and whose value unifies with \texttt{Value}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Flag} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Flag)} \ErrCond{\texttt{Flag} is an atom but not a valid flag} \ErrTerm{domain\_error(prolog\_flag, Flag)} \end{PlErrors} \Portability ISO predicate. \subsubsection{\IdxPBD{set\_bip\_name/2}\label{set-bip-name/2}} \begin{TemplatesOneCol} set\_bip\_name(+atom, +arity) \end{TemplatesOneCol} \Description \texttt{set\_bip\_name(Functor, Arity)} initializes the context of the error \RefSP{General-format-and-error-context} with \texttt{Functor} and \texttt{Arity} (if \texttt{Arity} $<$ 0 only \texttt{Functor} is significant). \begin{PlErrors} \ErrCond{\texttt{Functor} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Arity} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Functor} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Functor)} \ErrCond{\texttt{Arity} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Arity)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{current\_bip\_name/2}\label{current-bip-name/2}} \begin{TemplatesOneCol} current\_bip\_name(?atom, ?arity) \end{TemplatesOneCol} \Description \texttt{current\_bip\_name(Functor, Arity)} succeeds if \texttt{Functor} and \texttt{Arity} correspond to the context of the error \RefSP{General-format-and-error-context} (if \texttt{Arity} $<$ 0 only \texttt{Functor} is significant). \begin{PlErrors} \ErrCond{\texttt{Functor} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Functor)} \ErrCond{\texttt{Arity} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Arity)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{write\_pl\_state\_file/1},\label{write-pl-state-file/1} \IdxPBD{read\_pl\_state\_file/1}} \begin{TemplatesOneCol} write\_pl\_state\_file(+source\_sink)\\ read\_pl\_state\_file(+source\_sink) \end{TemplatesOneCol} \Description \texttt{write\_pl\_state\_file(FileName)} writes onto \texttt{FileName} all information that influences the parsing of a term \RefSP{Term-input/output}. This allows a sub-process written in Prolog to read this file and then process any Prolog term as done by the parent process. This file can also be passed as argument of the \IdxK{--pl-state} option when invoking \IdxK{gplc} \RefSP{Using-the-compiler}. More precisely the following elements are saved: \begin{itemize} \item all operator definitions \RefSP{op/3:(Term-input/output)}. \item the character conversion table \RefSP{char-conversion/2}. \item the value of \IdxPF{char\_conversion}, \IdxPF{double\_quotes}, \IdxPF{back\_quotes}, \IdxPF{singleton\_warning}, \IdxPF{suspicious\_warning} and \IdxPF{multifile\_warning} \Idx{Prolog flag}s \RefSP{set-prolog-flag/2}. \end{itemize} \texttt{read\_pl\_state\_file(FileName)} reads (restores) from \texttt{FileName} all information previously saved by \texttt{write\_pl\_state\_file/1.} \begin{PlErrors} \ErrCond{\texttt{FileName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{FileName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, FileName)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Program state} \subsubsection{\IdxPBD{consult/1},\label{consult/1} \IdxPBD{'.'/2} - program consult} \begin{TemplatesOneCol} consult(+atom\_or\_atom\_list)\\ '.'(+atom, +atom\_list) \end{TemplatesOneCol} \Description \texttt{consult(Files)} compiles and loads into memory each file of the list \texttt{Files}. Each file is compiled for byte-code using the GNU Prolog compiler \RefSP{The-GNU-Prolog-compiler} then loaded using \texttt{load/1} \RefSP{load/1}. It is possible to specify \IdxPK{user} as a file name to directly enter the program from the terminal. \texttt{Files} can be also a single file name (i.e. an atom). Refer to the section concerning the consult of a Prolog program for more information \RefSP{Consulting-a-Prolog-program}. The final file name of a file is computed using the predicates \IdxPB{prolog\_file\_name/2} \RefSP{prolog-file-name/2} and \IdxPB{absolute\_file\_name/2} \RefSP{absolute-file-name/2}. \texttt{[ File | Files ]}, i.e. \texttt{'.'(File, Files)} is equivalent to \texttt{consult([ File | Files ])}. Since version 1.4.0, with the introduction of \Idx{shebang support}, \texttt{consult/1} ignores the first line of a Prolog source file which directly begins with \texttt{\#}. See \RefSP{Scripting-Prolog} for more information about shebang support and \Idx{PrologScript}. \begin{PlErrors} \ErrCond{\texttt{Files} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Files} is neither a partial list nor a list nor an atom} \ErrTerm{type\_error(list, Files)} \ErrCond{an element \texttt{E} of the \texttt{Files} list is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{an element \texttt{E} of the \texttt{Files} list is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, E)} \ErrCond{an element \texttt{E} of the \texttt{Files} list is a valid pathname but does not correspond to an existing source} \ErrTerm{existence\_error(source\_sink, E)} \ErrCond{an error occurs executing a directive} \ErrTermRm{see \texttt{call/1} errors \RefSP{call/1}} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{load/1}\label{load/1}} \begin{TemplatesOneCol} load(+atom\_or\_atom\_list) \end{TemplatesOneCol} \Description \texttt{load(Files)} loads into memory each file of the list \texttt{Files}. Each file must have been previously compiled for byte-code using the GNU Prolog compiler \RefSP{The-GNU-Prolog-compiler}. \texttt{Files} can be also a single file name (i.e. an atom). The final file name of a file is computed using the predicates \IdxPB{absolute\_file\_name/2} \RefSP{absolute-file-name/2}. If no suffix is given \texttt{'.wbc'} is appended to the file name. \begin{PlErrors} \ErrCond{\texttt{Files} is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Files} is neither a partial list nor a list nor an atom} \ErrTerm{type\_error(list, Files)} \ErrCond{an element \texttt{E} of the \texttt{Files} list is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{an element \texttt{E} of the \texttt{Files} list is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, E)} \ErrCond{an element \texttt{E} of the \texttt{Files} list is a valid pathname but does not correspond to an existing source} \ErrTerm{existence\_error(source\_sink, E)} \ErrCond{an error occurs executing a directive} \ErrTermRm{see \texttt{call/1} errors \RefSP{call/1}} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{listing/1},\label{listing/1} \IdxPBD{listing/0}} \begin{TemplatesOneCol} listing(+predicate\_indicator)\\ listing(+atom)\\ listing \end{TemplatesOneCol} \Description \texttt{listing(Pred)} lists the clauses of the consulted predicate whose predicate indicator is \texttt{Pred}. \texttt{Pred} can also be a single atom in which case all predicates whose name is \texttt{Pred} are listed (of any arity). This predicate uses \IdxPB{portray\_clause/2} \RefSP{portray-clause/2} to output the clauses. \texttt{listing} lists all clauses of all consulted predicates. \begin{PlErrors} \ErrCond{\texttt{Pred} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Pred} is neither a variable nor predicate indicator or an atom} \ErrTerm{type\_error(predicate\_indicator, Pred)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{System statistics} \subsubsection{\IdxPBD{statistics/0},\label{statistics/2} \IdxPBD{statistics/2}} \begin{TemplatesOneCol} statistics\\ statistics(?atom, ?list) \end{TemplatesOneCol} \Description \texttt{statistics} displays statistics about memory usage and run times. \texttt{statistics(Key, Value)} unifies \texttt{Value} with the current value of the statistics key \texttt{Key}. \texttt{Value} a list of two elements. Times are in milliseconds, sizes of areas in bytes. \begin{tabular}{|l|l|l|} \hline Key & Description & Value \\ \hline\hline \texttt{user\_time} & user CPU time & \texttt{[SinceStart, SinceLast]} \\ \hline \texttt{system\_time} & system CPU time & \texttt{[SinceStart, SinceLast]} \\ \hline \texttt{cpu\_time} & total CPU time (user + system) & \texttt{[SinceStart, SinceLast]} \\ \hline \texttt{real\_time} & absolute time & \texttt{[SinceStart, SinceLast]} \\ \hline \texttt{local\_stack} & local stack sizes (control, environments, choices) & \texttt{[UsedSize, FreeSize]} \\ \hline \texttt{global\_stack} & global stack sizes (compound terms) & \texttt{[UsedSize, FreeSize]} \\ \hline \texttt{trail\_stack} & trail stack sizes (variable bindings to undo) & \texttt{[UsedSize, FreeSize]} \\ \hline \texttt{cstr\_stack} & constraint trail sizes (finite domain constraints) & \texttt{[UsedSize, FreeSize]} \\ \hline \texttt{atoms} & atom table & \texttt{[NumberOfAtoms, FreeNumberOfAtoms]} \\ \hline \end{tabular} Note that the key \texttt{runtime} is recognized as \texttt{user\_time} for compatibility purpose. \begin{PlErrors} \ErrCond{\texttt{Key} is neither a variable nor a valid key} \ErrTerm{domain\_error(statistics\_key, Key)} \ErrCond{\texttt{Value} is neither a variable nor a list of two elements} \ErrTerm{domain\_error(statistics\_value, Value)} \ErrCond{\texttt{Value} is a list of two elements and an element \texttt{E} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{user\_time/1},\label{user-time/1} \IdxPBD{system\_time/1}, \IdxPBD{cpu\_time/1}, \IdxPBD{real\_time/1}} \begin{TemplatesOneCol} user\_time(?integer)\\ system\_time(?integer)\\ cpu\_time(?integer)\\ real\_time(?integer) \end{TemplatesOneCol} \Description \texttt{user\_time(Time)} unifies \texttt{Time} with the user CPU time elapsed since the start of Prolog. \texttt{system\_time(Time)} unifies \texttt{Time} with the system CPU time elapsed since the start of Prolog. \texttt{cpu\_time(Time)} unifies \texttt{Time} with the CPU time (user + system) elapsed since the start of Prolog. \texttt{real\_time(Time)} unifies \texttt{Time} with the absolute time elapsed since the start of Prolog. \begin{PlErrors} \ErrCond{\texttt{Time} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Time)} \end{PlErrors} \Portability GNU Prolog predicates. \subsection{Random number generator} \subsubsection{\IdxPBD{set\_seed/1}, \IdxPBD{randomize/0}} \begin{TemplatesOneCol} set\_seed(+integer)\\ randomize \end{TemplatesOneCol} \Description \texttt{set\_seed(Seed)} reinitializes the random number generator seed with \texttt{Seed}. \texttt{randomize} reinitializes the random number generator. This predicates calls \texttt{set\_seed/1} with a random value depending on the absolute time. \begin{PlErrors} \ErrCond{\texttt{Seed} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Seed} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Seed)} \ErrCond{\texttt{Seed} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Seed)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{get\_seed/1}} \begin{TemplatesOneCol} get\_seed(?integer) \end{TemplatesOneCol} \Description \texttt{get\_seed(Seed)} unifies \texttt{Seed} with the current random number generator seed. \begin{PlErrors} \ErrCond{\texttt{Seed} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Seed)} \ErrCond{\texttt{Seed} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Seed)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{random/1}} \begin{TemplatesOneCol} random(-float) \end{TemplatesOneCol} \Description \texttt{random(Number)} unifies \texttt{Number} with a random floating point number such that 0.0 $\leq$ \texttt{Number} $<$ 1.0. \begin{PlErrors} \ErrCond{\texttt{Number} is not a variable} \ErrTerm{uninstantiation\_error(Number)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{random/3}} \begin{TemplatesOneCol} random(+number, +number, -number) \end{TemplatesOneCol} \Description \texttt{random(Base, Max, Number)} unifies \texttt{Number} with a random number such that \texttt{Base} $\leq$ \texttt{Number} $<$ \texttt{Max}. If both \texttt{Base} and \texttt{Max} are integers \texttt{Number} will be an integer, otherwise \texttt{Number} will be a floating point number. \begin{PlErrors} \ErrCond{\texttt{Base} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Base} is neither a variable nor a number} \ErrTerm{type\_error(number, Base)} \ErrCond{\texttt{Max} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Max} is neither a variable nor a number} \ErrTerm{type\_error(number, Max)} \ErrCond{\texttt{Number} is not a variable} \ErrTerm{uninstantiation\_error(Number)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{File name processing} \subsubsection{\IdxPBD{absolute\_file\_name/2}\label{absolute-file-name/2}} \begin{TemplatesOneCol} absolute\_file\_name(+atom, atom) \end{TemplatesOneCol} \Description \texttt{absolute\_file\_name(File1, File2)} succeeds if \texttt{File2} is the absolute pathname associated with the relative file name \texttt{File1}. \texttt{File1} can contain \texttt{\$\Param{VAR\_NAME}} sub-strings. When such a sub-string is encountered, it is expanded with the value of the environment variable whose name is \Param{VAR\_NAME} if exists (otherwise no expansion is done). \texttt{File1} can also begin with a sub-string \texttt{\~{}\Param{USER\_NAME}/}, this is expanded as the home directory of the user \Param{USER\_NAME}. If \Param{USER\_NAME} does not exist \texttt{File1} is an invalid pathname. If no \Param{USER\_NAME} is given (i.e. \texttt{File1} begins with \texttt{\~{}/}) the \texttt{\~{}} character is expanded as the value of the environment variable \texttt{HOME}. If the \texttt{HOME} variable is not defined \texttt{File1} is an invalid pathname. Relative references to the current directory (\texttt{/./} sub-string) and to the parent directory (\texttt{/../} sub-strings) are removed and no longer appear in \texttt{File2}. \texttt{File1} is also invalid if it contains too many \texttt{/../} consecutive sub-strings (i.e. parent directory relative references). Finally if \texttt{File1} is \IdxPK{user} then \texttt{File2} is also unified with \texttt{user} to allow this predicate to be called on Prolog file names (since \texttt{user} in DEC-10 input/output predicates denotes the current input/output stream). Under Windows the following applies: \begin{itemize} \item an alternate recognized form for \texttt{\$\Param{VAR\_NAME}} is \texttt{\%\Param{VAR\_NAME}\%}. \item when \texttt{\~{}} is expanded, if the \texttt{HOME} variable is not defined, \texttt{\~{}} is expanded using \texttt{HOMEDIR} and \texttt{HOMEPATH} (if \texttt{HOMEPATH} is not defined then \texttt{File1} is an invalid pathname). \end{itemize} Most predicates using a file name implicitly call this predicate to obtain the desired file, e.g. \texttt{open/4}. \begin{PlErrors} \ErrCond{\texttt{File1} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{File1} is neither a variable nor an atom} \ErrTerm{type\_error(atom, File1)} \ErrCond{\texttt{File2} is neither a variable nor an atom} \ErrTerm{type\_error(atom, File2)} \ErrCond{\texttt{File1} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, File1)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{is\_absolute\_file\_name/1}, \IdxPBD{is\_relative\_file\_name/1}} \begin{TemplatesOneCol} is\_absolute\_file\_name(+atom)\\ is\_relative\_file\_name(+atom) \end{TemplatesOneCol} \Description \texttt{is\_absolute\_file\_name(PathName)} succeeds if \texttt{PathName} is an absolute file name. Conversely, \texttt{is\_relative\_file\_name(PathName)} succeeds if \texttt{PathName} is not an absolute file name. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName} \RefSP{absolute-file-name/2}. The current implementation does not check the validity of \texttt{PathName}. If \texttt{PathName} starts with a \texttt{/} (slash) it is considered as absolute. Under Windows, \texttt{PathName} can also start with a \texttt{{\bs}} (backslash) or a drive specification. \begin{PlErrors} \ErrCond{\texttt{PathName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{decompose\_file\_name/4}} \begin{TemplatesOneCol} decompose\_file\_name(+atom, ?atom, ?atom, ?atom) \end{TemplatesOneCol} \Description \texttt{decompose\_file\_name(File, Directory, Prefix, Suffix)} decomposes the pathname \texttt{File} and extracts the \texttt{Directory} part (characters before the last \texttt{/}), the \texttt{Prefix} part (characters after the last \texttt{/} and before the last \texttt{.} or until the end if there is no suffix) and the \texttt{Suffix} part (characters from the last \texttt{.} to the end of the string). \begin{PlErrors} \ErrCond{\texttt{File} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{File} is neither a variable nor an atom} \ErrTerm{type\_error(atom, File)} \ErrCond{\texttt{Directory} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Directory)} \ErrCond{\texttt{Prefix} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Prefix)} \ErrCond{\texttt{Suffix} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Suffix)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{prolog\_file\_name/2}\label{prolog-file-name/2}} \begin{TemplatesOneCol} prolog\_file\_name(+atom, ?atom) \end{TemplatesOneCol} \Description \texttt{prolog\_file\_name(File1, File2)} unifies \texttt{File2} with the Prolog file name associated with \texttt{File1}. More precisely \texttt{File2} is computed as follows: \begin{itemize} \item if \texttt{File1} has a suffix or if it is \IdxPK{user} then \texttt{File2} is unified with \texttt{File1}. \item else if the file whose name is \texttt{File1} + \texttt{'.pl'} exists then \texttt{File2} is unified with this name. \item else if the file whose name is \texttt{File1} + \texttt{'.pro'} exists then \texttt{File2} is unified with this name. \item else if the file whose name is \texttt{File1} + \texttt{'.prolog'} exists then \texttt{File2} is unified with this name. \item else \texttt{File2} is unified with the name \texttt{File1} + \texttt{'.pl'}. \end{itemize} This predicate uses \IdxPB{absolute\_file\_name/2} to check the existence of a file \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{File1} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{File1} is neither a variable nor an atom} \ErrTerm{type\_error(atom, File1)} \ErrCond{\texttt{File2} is neither a variable nor an atom} \ErrTerm{type\_error(atom, File2)} \ErrCond{\texttt{File1} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, File1)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Operating system interface} \subsubsection{\IdxPBD{argument\_counter/1}\label{argument-counter/1}} \begin{TemplatesOneCol} argument\_counter(?integer) \end{TemplatesOneCol} \Description \texttt{argument\_counter(Counter)} succeeds if \texttt{Counter} is the number of arguments of the command-line. Since the first argument is always the name of the running program, \texttt{Counter} is always $\geq$ 1. See \RefSP{The-GNU-Prolog-interactive-interpreter} for more information about command-line arguments retrieved under the top\_level. \begin{PlErrors} \ErrCond{\texttt{Counter} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Counter)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{argument\_value/2}\label{argument-value/2}} \begin{TemplatesOneCol} argument\_value(+integer, ?atom) \end{TemplatesOneCol} \Description \texttt{argument\_value(N, Arg)} succeeds if the \texttt{N}\emph{th} argument on the command-line unifies with \texttt{Arg}. The first argument is always the name of the running program and its number is 0. The number of arguments on the command-line can be obtained using \texttt{argument\_counter/1} \RefSP{argument-counter/1}. \begin{PlErrors} \ErrCond{\texttt{N} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{N} is neither a variable nor an integer} \ErrTerm{type\_error(integer, N)} \ErrCond{\texttt{N} is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, N)} \ErrCond{\texttt{Arg} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Arg)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{argument\_list/1}\label{argument-list/1}} \begin{TemplatesOneCol} argument\_list(?list) \end{TemplatesOneCol} \Description \texttt{argument\_list(Args)} succeeds if \texttt{Args} unifies with the list of atoms associated with each argument on the command-line other than the first argument (the name of the running program). \begin{PlErrors} \ErrCond{\texttt{Args} is neither a partial list nor a list} \ErrTerm{type\_error(list, Args)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{environ/2}} \begin{TemplatesOneCol} environ(?atom, ?atom) \end{TemplatesOneCol} \Description \texttt{environ(Name, Value)} succeeds if \texttt{Name} is the name of an environment variable whose value is \texttt{Value}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Name} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Name)} \ErrCond{\texttt{Value} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Value)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{make\_directory/1}, \IdxPBD{delete\_directory/1}, \IdxPBD{change\_directory/1}} \begin{TemplatesOneCol} make\_directory(+atom)\\ delete\_directory(+atom)\\ change\_directory(+atom) \end{TemplatesOneCol} \Description \texttt{make\_directory(PathName)} creates the directory whose pathname is \texttt{PathName}. \texttt{delete\_directory(PathName)} removes the directory whose pathname is \texttt{PathName}. \texttt{change\_directory(PathName)} sets the current directory to the directory whose pathname is \texttt{PathName}. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{PathName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{\texttt{PathName} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{working\_directory/1}} \begin{TemplatesOneCol} working\_directory(?atom) \end{TemplatesOneCol} \Description \texttt{working\_directory(PathName)} succeeds if \texttt{PathName} is the pathname of the current directory. \begin{PlErrors} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{directory\_files/2}} \begin{TemplatesOneCol} directory\_files(+atom, ?list) \end{TemplatesOneCol} \Description \texttt{directory\_files(PathName, Files)} succeeds if \texttt{Files} is the list of all entries (files, sub-directories,\ldots) in the directory whose pathname is \texttt{PathName}. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{PathName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{\texttt{PathName} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName)} \ErrCond{\texttt{Files} is neither a partial list nor a list} \ErrTerm{type\_error(list, Files)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{rename\_file/2}} \begin{TemplatesOneCol} rename\_file(+atom, +atom) \end{TemplatesOneCol} \Description \texttt{rename\_file(PathName1, PathName2)} renames the file or directory whose pathname is \texttt{PathName1} to \texttt{PathName2}. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName1} and \texttt{PathName2} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{PathName1} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName1} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName1)} \ErrCond{\texttt{PathName1} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName1)} \ErrCond{\texttt{PathName2} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName2} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName2)} \ErrCond{\texttt{PathName2} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName2)} \ErrCond{an operating system error occurs and value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{delete\_file/1}, \IdxPBD{unlink/1}} \begin{TemplatesOneCol} delete\_file(PathName)\\ unlink(PathName) \end{TemplatesOneCol} \Description \texttt{delete\_file(PathName)} removes the existing file whose pathname is \texttt{PathName}. \texttt{unlink/1} is similar to \texttt{delete\_file/1} except that it never causes a \texttt{system\_error} (e.g. if \texttt{PathName} does not refer to an existing file). See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{PathName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{\texttt{PathName} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{file\_permission/2},\label{file-permission/2} \IdxPBD{file\_exists/1}} \begin{TemplatesOneCol} file\_permission(+atom, +atom)\\ file\_permission(+atom, +atom\_list)\\ file\_exists(+atom) \end{TemplatesOneCol} \Description \texttt{file\_permission(PathName, Permission)} succeeds if \texttt{PathName} is the pathname of an existing file (or directory) whose permissions include \texttt{Permission}. \SPart{File permissions}: \texttt{Permission} can be a single permission or a list of permissions. A permission is an atom among: \begin{itemize} \item \IdxPXD{read}: the file or directory can be read. \item \IdxPXD{write}: the file or directory can be written. \item \IdxPXD{execute}: the file can be executed. \item \IdxPXD{search}: the directory can be searched. \end{itemize} If \texttt{PathName} does not exists or if its permissions do not include \texttt{Permission} this predicate fails. \texttt{file\_exists(PathName)} is equivalent to \texttt{file\_permission(PathName, [])}, i.e. it succeeds if \texttt{PathName} is the pathname of an existing file (or directory). See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{PathName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{\texttt{PathName} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName)} \ErrCond{\texttt{Permission} is a partial list or a list with an element which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Permission} is neither an atom nor partial list or a list} \ErrTerm{type\_error(list, Permission)} \ErrCond{an element \texttt{E} of the \texttt{Permission} list is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{an element \texttt{E} of the \texttt{Permission} is an atom but not a valid permission} \ErrTerm{domain\_error(os\_file\_permission, Permission)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{file\_property/2}\label{file-property/2}} \begin{TemplatesOneCol} file\_property(+atom, ?os\_file\_property) \end{TemplatesOneCol} \Description \texttt{file\_property(PathName, Property)} succeeds if \texttt{PathName} is the pathname of an existing file (or directory) and if \texttt{Property} unifies with one of the properties of the file. This predicate is re-executable on backtracking. \SPart{File properties}: \begin{itemize} \item \AddPPD{absolute\_file\_name}\texttt{absolute\_file\_name(File)}: \texttt{File} is the absolute file name of \texttt{PathName} \RefSP{absolute-file-name/2}. \item \AddPPD{real\_file\_name}\texttt{real\_file\_name(File)}: \texttt{File} is the real file name of \texttt{PathName} (follows symbolic links). \item \AddPPD{type}\texttt{type(Type)}: \texttt{Type} is the type of \texttt{PathName}. Possible values are: \IdxPXD{regular}, \IdxPXD{directory}, \IdxPXD{fifo}, \IdxPXD{socket}, \IdxPXD{character\_device}, \IdxPXD{block\_device} or \IdxPXD{unknown}. \item \AddPPD{size}\texttt{size(Size)}: \texttt{Size} is the size (in bytes) of \texttt{PathName}. \item \AddPPD{permission}\texttt{permission(Permission)}: \texttt{Permission} is a permission of \texttt{PathName} \RefSP{file-permission/2}. \item \AddPPD{last\_modification}\texttt{last\_modification(DT)}: \texttt{DT} is the last modification date and time \RefSP{date-time/1}. \end{itemize} See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{PathName} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{PathName} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{\texttt{PathName} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, PathName)} \ErrCond{\texttt{Property} is neither a variable nor a file property term} \ErrTerm{domain\_error(os\_file\_property, Property)} \ErrCond{\texttt{Property} = \texttt{absolute\_file\_name(E)}, \texttt{real\_file\_name(E)}, \texttt{type(E)} or \texttt{permission(E)} and \texttt{E} is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{\texttt{Property} = \texttt{last\_modification(DateTime)} and \texttt{DateTime} is neither a variable nor a compound term} \ErrTerm{type\_error(compound, DateTime)} \ErrCond{\texttt{Property} = \texttt{last\_modification(DateTime)} and \texttt{DateTime} is a compound term but not a structure \texttt{dt/6}} \ErrTerm{domain\_error(date\_time, DateTime)} \ErrCond{\texttt{Property} = \texttt{size(E)} or \texttt{last\_modification(DateTime)} and \texttt{DateTime} is a structure \texttt{dt/6} but an element \texttt{E} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{temporary\_name/2}} \begin{TemplatesOneCol} temporary\_name(+atom, ?atom) \end{TemplatesOneCol} \Description \texttt{temporary\_name(Template, PathName)} creates a unique file name \texttt{PathName} whose pathname begins by \texttt{Template}. \texttt{Template} should contain a pathname with six trailing \texttt{X}\emph{s}. \texttt{PathName} is \texttt{Template} with the six \texttt{X}\emph{s} replaced with a letter and the process identifier. This predicate is an interface to the C Unix function \texttt{mktemp(3)}. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{Template} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{Template} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Template} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Template)} \ErrCond{\texttt{Template} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, Template)} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{temporary\_file/3}} \begin{TemplatesOneCol} temporary\_file(+atom, +atom, ?atom) \end{TemplatesOneCol} \Description \texttt{temporary\_file(Directory, Prefix, PathName)} creates a unique file name \texttt{PathName} whose pathname begins by \texttt{Directory/Prefix}. If \texttt{Directory} is the empty atom \texttt{''} a standard temporary directory will be used (e.g. \texttt{/tmp}). \texttt{Prefix} can be the empty atom \texttt{''}. This predicate is an interface to the C Unix function \texttt{tempnam(3)}. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{Directory} \RefSP{absolute-file-name/2}. \begin{PlErrors} \ErrCond{\texttt{Directory} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Directory} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Directory)} \ErrCond{\texttt{Directory} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, Directory)} \ErrCond{\texttt{Prefix} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Prefix} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Prefix)} \ErrCond{\texttt{PathName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, PathName)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{date\_time/1}\label{date-time/1}} \begin{TemplatesOneCol} date\_time(?compound) \end{TemplatesOneCol} \Description \texttt{date\_time(DateTime)} unifies \texttt{DateTime} with a compound term containing the current date and time. \texttt{DateTime} is a structure \texttt{dt(Year, Month, Day, Hour, Minute, Second)}. Each sub-argument of the term \texttt{dt/6} is an integer. \begin{PlErrors} \ErrCond{\texttt{DateTime} is neither a variable nor a compound term} \ErrTerm{type\_error(compound, DateTime)} \ErrCond{\texttt{DateTime} is a compound term but not a structure \texttt{dt/6}} \ErrTerm{domain\_error(date\_time, DateTime)} \ErrCond{\texttt{DateTime} is a structure \texttt{dt/6} and an element \texttt{E} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{host\_name/1}} \begin{TemplatesOneCol} host\_name(?atom) \end{TemplatesOneCol} \Description \texttt{host\_name(HostName)} unifies \texttt{HostName} with the name of the host machine executing the current GNU Prolog process. If the sockets are available \RefSP{Introduction:(Sockets-input/output)}, the name returned will be fully qualified. In that case, \texttt{host\_name/1} will also succeed if \texttt{HostName} is instantiated to the unqualified name (or an alias) of the machine. \begin{PlErrors} \ErrCond{\texttt{HostName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, HostName)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{os\_version/1}} \begin{TemplatesOneCol} os\_version(?atom) \end{TemplatesOneCol} \Description \texttt{os\_version(OSVersion)} unifies \texttt{OSVersion} with the operating system version of the machine executing the current GNU Prolog process. \begin{PlErrors} \ErrCond{\texttt{OSVersion} is neither a variable nor an atom} \ErrTerm{type\_error(atom, OSVersion)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{architecture/1}} \begin{TemplatesOneCol} architecture(?atom) \end{TemplatesOneCol} \Description \texttt{architecture(Architecture)} unifies \texttt{Architecture} with the name of the machine executing the current GNU Prolog process. \begin{PlErrors} \ErrCond{\texttt{Architecture} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Architecture)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{shell/2}, \IdxPBD{shell/1}, \IdxPBD{shell/0}} \begin{TemplatesOneCol} shell(+atom, ?integer)\\ shell(+atom)\\ shell \end{TemplatesOneCol} \Description \texttt{shell(Command, Status)} invokes a new shell (named by the \texttt{SHELL} environment variable) passing \texttt{Command} for execution and unifies \texttt{Status} with the result of the execution. If \texttt{Command} is the empty atom \texttt{''} a new interactive shell is executed. The control is returned to Prolog upon termination of the called process. \texttt{shell(Command)} is equivalent to \texttt{shell(Command, 0)}. \texttt{shell} is equivalent to \texttt{shell('', 0)}. \begin{PlErrors} \ErrCond{\texttt{Command} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Command} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Command)} \ErrCond{\texttt{Status} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Status)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{system/2}, \IdxPBD{system/1}} \begin{TemplatesOneCol} system(+atom, ?integer)\\ system(+atom) \end{TemplatesOneCol} \Description \texttt{system(Command, Status)} invokes a new default shell passing \texttt{Command} for execution and unifies \texttt{Status} with the result of the execution. The control is returned to Prolog upon termination of the shell process. This predicate is an interface to the C Unix function \texttt{system(3)}. \texttt{system(Command)} is equivalent to \texttt{system(Command, 0)}. \begin{PlErrors} \ErrCond{\texttt{Command} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Command} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Command)} \ErrCond{\texttt{Status} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Status)} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{spawn/3}, \IdxPBD{spawn/2}} \begin{TemplatesOneCol} spawn(+atom, +atom\_list, ?integer)\\ spawn(+atom, +atom\_list) \end{TemplatesOneCol} \Description \texttt{spawn(Command, Arguments, Status)} executes \texttt{Command} passing as arguments of the command-line each element of the list \texttt{Arguments} and unifies \texttt{Status} with the result of the execution. The control is returned to Prolog upon termination of the command. \texttt{spawn(Command, Arguments)} is equivalent to \texttt{spawn(Command, Arguments, 0)}. \begin{PlErrors} \ErrCond{\texttt{Command} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Command} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Command)} \ErrCond{\texttt{Arguments} is a partial list or a list with an element which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Arguments} is neither a partial list nor a list} \ErrTerm{type\_error(list, Arguments)} \ErrCond{an element \texttt{E} of the \texttt{Arguments} list is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{\texttt{Status} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Status)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{popen/3}\label{popen/3}} \begin{TemplatesOneCol} popen(+atom, +io\_mode, -stream) \end{TemplatesOneCol} \Description \texttt{popen(Command, Mode, Stream)} invokes a new default shell (by creating a pipe) passing \texttt{Command} for execution and associates a stream either to the standard input or the standard output of the created process. if \texttt{Mode} is \texttt{read} (resp. \texttt{write}) an input (resp. output) stream is created and \texttt{Stream} is unified with the stream-term associated. Writing to the stream writes to the standard input of the command while reading from the stream reads the command's standard output. The stream must be closed using \IdxPB{close/2} \RefSP{close/2}. This predicate is an interface to the C Unix function \texttt{popen(3)}. \begin{PlErrors} \ErrCond{\texttt{Command} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Command} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Command)} \ErrCond{\texttt{Mode} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Mode} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Mode)} \ErrCond{\texttt{Mode} is an atom but neither \texttt{read} nor \texttt{write}.} \ErrTerm{domain\_error(io\_mode, Mode)} \ErrCond{\texttt{Stream} is not a variable} \ErrTerm{uninstantiation\_error(Stream)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{exec/5}, \IdxPBD{exec/4}} \begin{TemplatesOneCol} exec(+atom, -stream, -stream, -stream, -integer)\\ exec(+atom, -stream, -stream, -stream) \end{TemplatesOneCol} \Description \texttt{exec(Command, StreamIn, StreamOut, StreamErr, Pid)} invokes a new default shell passing \texttt{Command} for execution and associates streams to standard streams of the created process. \texttt{StreamIn} is unified with the stream-term associated with the standard input stream of \texttt{Command} (it is an output stream). \texttt{StreamOut} is unified with the stream-term associated with the standard output stream of \texttt{Command} (it is an input stream). \texttt{StreamErr} is unified with the stream-term associated with the standard error stream of \texttt{Command} (it is an input stream). \texttt{Pid} is unified with the process identifier of the new process. This information is only useful if it is necessary to obtain the status of the execution using \texttt{wait/2} \RefSP{wait/2}. Until a call to \texttt{wait/2} is done the process remains in the system processes table (as a zombie process if terminated). For this reason, if the status is not needed it is preferable to use \texttt{exec/4}. \texttt{exec/4} is similar to \texttt{exec/5} but the process is removed from system processes as soon as it is terminated. \begin{PlErrors} \ErrCond{\texttt{Command} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Command} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Command)} \ErrCond{\texttt{StreamIn} is not a variable} \ErrTerm{uninstantiation\_error(StreamIn)} \ErrCond{\texttt{StreamOut} is not a variable} \ErrTerm{uninstantiation\_error(StreamOut)} \ErrCond{\texttt{StreamErr} is not a variable} \ErrTerm{uninstantiation\_error(StreamErr)} \ErrCond{\texttt{Pid} is not a variable} \ErrTerm{uninstantiation\_error(Pid)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{fork\_prolog/1}} \begin{TemplatesOneCol} fork\_prolog(-integer) \end{TemplatesOneCol} \Description \texttt{fork\_prolog(Pid)} creates a child process that differs from the parent process only in its PID. In the parent process \texttt{Pid} is unified with the PID of the child while in the child process \texttt{Pid} is unified with 0. In the parent process, the status of the child process can be obtained using \texttt{wait/2} \RefSP{wait/2}. Until a call to \texttt{wait/2} is done the child process remains in the system processes table (as a zombie process if terminated). This predicate is an interface to the C Unix function \texttt{fork(2)}. \begin{PlErrors} \ErrCond{\texttt{Pid} is not a variable} \ErrTerm{uninstantiation\_error(Pid)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{create\_pipe/2}} \begin{TemplatesOneCol} create\_pipe(-stream, -stream) \end{TemplatesOneCol} \Description \texttt{create\_pipe(StreamIn, StreamOut)} creates a pair of streams pointing to a pipe inode. \texttt{StreamIn} is unified with the stream-term associated with the input side of the pipe and \texttt{StreamOut} is unified with the stream-term associated with output side. This predicate is an interface to the C Unix function \texttt{pipe(2)}. \begin{PlErrors} \ErrCond{\texttt{StreamIn} is not a variable} \ErrTerm{uninstantiation\_error(StreamIn)} \ErrCond{\texttt{StreamOut} is not a variable} \ErrTerm{uninstantiation\_error(StreamOut)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{wait/2}\label{wait/2}} \begin{TemplatesOneCol} wait(+integer, ?integer) \end{TemplatesOneCol} \Description \texttt{wait(Pid, Status)} waits for the child process whose identifier is \texttt{Pid} to terminate. \texttt{Status} is then unified with the exit status. This predicate is an interface to the C Unix function \texttt{waitpid(2)}. \begin{PlErrors} \ErrCond{\texttt{Pid} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Pid} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Pid)} \ErrCond{\texttt{Status} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Status)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{prolog\_pid/1}} \begin{TemplatesOneCol} prolog\_pid(?integer) \end{TemplatesOneCol} \Description \texttt{prolog\_pid(Pid)} unifies \texttt{Pid} with the process identifier of the current GNU Prolog process. \begin{PlErrors} \ErrCond{\texttt{Pid} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Pid)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{send\_signal/2}} \begin{TemplatesOneCol} send\_signal(+integer, +integer)\\ send\_signal(+integer, +atom) \end{TemplatesOneCol} \Description \texttt{send\_signal(Pid, Signal)} sends \texttt{Signal} to the process whose identifier is \texttt{Pid.} \texttt{Signal} can be specified directly as an integer or symbolically as an atom. Allowed atoms depend on the machine (e.g. \texttt{'SIGINT'}, \texttt{'SIGQUIT'}, \texttt{'SIGKILL'}, \texttt{'SIGUSR1'}, \texttt{'SIGUSR2'}, \texttt{'SIGALRM'},\ldots). This predicate is an interface to the C Unix function \texttt{kill(2)}. \begin{PlErrors} \ErrCond{\texttt{Pid} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Pid} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Pid)} \ErrCond{\texttt{Signal} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Signal} is neither a variable nor an integer or an atom} \ErrTerm{type\_error(integer, Signal)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{sleep/1}} \begin{TemplatesOneCol} sleep(+number) \end{TemplatesOneCol} \Description \texttt{sleep(Seconds)} puts the GNU Prolog process to sleep for \texttt{Second}s seconds. \texttt{Seconds} can be an integer or a floating point number (in which case it can be $<$ 1). This predicate is an interface to the C Unix function \texttt{usleep(3)}. \begin{PlErrors} \ErrCond{\texttt{Seconds} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Seconds} is neither a variable nor a number} \ErrTerm{type\_error(number, Seconds)} \ErrCond{\texttt{Seconds} is a number $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, Seconds)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{select/5}\label{select/5}} \begin{TemplatesOneCol} select(+list, ?list, +list, ?list, +number) \end{TemplatesOneCol} \Description \texttt{select(Reads, ReadyReads, Writes, ReadyWrites, TimeOut)} waits for a number of streams (or file descriptors) to change status. \texttt{ReadyReads} is unified with the list of elements listed in \texttt{Reads} that have characters available for reading. Similarly \texttt{ReadyWrites} is unified with the list of elements of \texttt{Writes} that are ok for immediate writing. The elements of \texttt{Reads} and \texttt{Writes} are either stream-terms or aliases or integers considered as file descriptors, e.g. for sockets \RefSP{Sockets-input/output}. Streams that must be tested with \texttt{select/5} should not be buffered. This can be done at the opening using \IdxPB{open/4} \RefSP{open/4} or later using \IdxPB{set\_stream\_buffering/2} \RefSP{set-stream-buffering/2}. \texttt{TimeOut} is an upper bound on the amount of time (in milliseconds) elapsed before \texttt{select/5} returns. If \texttt{TimeOut} $\leq$ 0 (no timeout) \texttt{select/5} waits until something is available (either or reading or for writing) and thus can block indefinitely. This predicate is an interface to the C Unix function \texttt{select(2)}. \begin{PlErrors} \ErrCond{\texttt{Reads} (or \texttt{Writes}) is a partial list or a list with an element \texttt{E} which is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Reads} is neither a partial list nor a list} \ErrTerm{type\_error(list, Reads)} \ErrCond{\texttt{Writes} is neither a partial list nor a list} \ErrTerm{type\_error(list, Writes)} \ErrCond{\texttt{ReadyReads} is neither a partial list nor a list} \ErrTerm{type\_error(list, ReadyReads)} \ErrCond{\texttt{ReadyWrites} is neither a partial list nor a list} \ErrTerm{type\_error(list, ReadyWrites)} \ErrCond{an element \texttt{E} of the \texttt{Reads} (or \texttt{Writes}) list is neither a stream-term or alias nor an integer} \ErrTerm{domain\_error(stream\_or\_alias, E)} \ErrCond{an element \texttt{E} of the \texttt{Reads} (or \texttt{Writes}) list is not a selectable item} \ErrTerm{domain\_error(selectable\_item, E)} \ErrCond{an element \texttt{E} of the \texttt{Reads} (or \texttt{Writes}) list is an integer $<$ 0} \ErrTerm{domain\_error(not\_less\_than\_zero, E)} \ErrCond{an element \texttt{E} of the \texttt{Reads} (or \texttt{Writes}) list is a stream-tern or alias not associated with an open stream} \ErrTerm{existence\_error(stream, E)} \ErrCond{an element \texttt{E} of the \texttt{Reads} list is associated with an output stream} \ErrTerm{permission\_error(input, stream, E)} \ErrCond{an element \texttt{E} of the \texttt{Writes} list is associated with an input stream} \ErrTerm{permission\_error(output, stream, E)} \ErrCond{\texttt{TimeOut} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{TimeOut} is neither a variable nor a number} \ErrTerm{type\_error(number, TimeOut)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Sockets input/output} \label{Sockets-input/output} \subsubsection{Introduction} \label{Introduction:(Sockets-input/output)} This set of predicates provides a way to manipulate sockets. The predicates are straightforward interfaces to the corresponding BSD-type socket functions. This facility is available if the sockets part of GNU Prolog has been installed. A reader familiar with BSD sockets will understand them immediately otherwise a study of sockets is needed. The domain is either the atom \texttt{'AF\_INET'} or \texttt{'AF\_UNIX'} corresponding to the same domains in BSD-type sockets. An address is either of the form \texttt{'AF\_INET'(HostName, Port)} or \texttt{'AF\_UNIX'(SocketName)}. \texttt{HostName} is an atom denoting a machine name, \texttt{Port} is a port number and \texttt{SocketName} is an atom denoting a socket. By default, streams associated with sockets are \texttt{block} buffered. The predicate \IdxPB{set\_stream\_buffering/2} \RefSP{set-stream-buffering/2} can be used to change this mode. They are also text streams by default. Use \IdxPB{set\_stream\_type/2} \RefSP{set-stream-type/2} to change the type if binary streams are needed. \subsubsection{\IdxPBD{socket/2}} \begin{TemplatesOneCol} socket(+socket\_domain, -integer) \end{TemplatesOneCol} \Description \texttt{socket(Domain, Socket)} creates a socket whose domain is \texttt{Domain} \RefSP{Sockets-input/output} and unifies \texttt{Socket} with the descriptor identifying the socket. This predicate is an interface to the C Unix function \texttt{socket(2)}. \begin{PlErrors} \ErrCond{\texttt{Domain} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Domain} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Domain)} \ErrCond{\texttt{Domain} is an atom but not a valid socket domain} \ErrTerm{domain\_error(socket\_domain, Domain)} \ErrCond{\texttt{Socket} is not a variable} \ErrTerm{uninstantiation\_error(Socket)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{socket\_close/1}} \begin{TemplatesOneCol} socket\_close(+integer) \end{TemplatesOneCol} \Description \texttt{socket\_close(Socket)} closes the socket whose descriptor is \texttt{Socket}. This predicate should not be used if \texttt{Socket} has given rise to a stream, e.g. by \IdxPB{socket\_connect/4} \RefSP{socket-connect/4}. In that case simply use \IdxPB{close/2} \RefSP{close/2} on the associated stream. \begin{PlErrors} \ErrCond{\texttt{Socket} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Socket} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Socket)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{socket\_bind/2}} \begin{TemplatesOneCol} socket\_bind(+integer, +socket\_address) \end{TemplatesOneCol} \Description \texttt{socket\_bind(Socket, Address)} binds the socket whose descriptor is \texttt{Socket} to the address specified by \texttt{Address} \RefSP{Sockets-input/output}. If \texttt{Address} if of the form \texttt{'AF\_INET'(HostName, Port)} and if \texttt{HostName} is uninstantiated then it is unified with the current machine name. If \texttt{Port} is uninstantiated, it is unified to a port number picked by the operating system. This predicate is an interface to the C Unix function \texttt{bind(2)}. \begin{PlErrors} \ErrCond{\texttt{Socket} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Socket} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Socket)} \ErrCond{\texttt{Address} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Address} is neither a variable nor a valid address} \ErrTerm{domain\_error(socket\_address, Address)} \ErrCond{\texttt{Address} = \texttt{'AF\_UNIX'(E)} and \texttt{E} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Address} = \texttt{'AF\_UNIX'(E)} or \texttt{'AF\_INET'(E, \_)} and \texttt{E} is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{\texttt{Address} = \texttt{'AF\_UNIX'(E)} and \texttt{E} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, E)} \ErrCond{\texttt{Address} = \texttt{'AF\_INET'(\_, E)} and \texttt{E} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{socket\_connect/4}\label{socket-connect/4}} \begin{TemplatesOneCol} socket\_connect(+integer, +socket\_address, -stream, -stream) \end{TemplatesOneCol} \Description \texttt{socket\_connect(Socket, Address, StreamIn, StreamOut)} connects the socket whose descriptor is \texttt{Socket} to the address specified by \texttt{Address} \RefSP{Sockets-input/output}. \texttt{StreamIn} is unified with a stream-term associated with the input of the connection (it is an input stream). Reading from this stream gets data from the socket. \texttt{StreamOut} is unified with a stream-term associated with the output of the connection (it is an output stream). Writing to this stream sends data to the socket. The use of \IdxPB{select/5} can be useful \RefSP{select/5}. This predicate is an interface to the C Unix function \texttt{connect(2)}. \begin{PlErrors} \ErrCond{\texttt{Socket} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Socket} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Socket)} \ErrCond{\texttt{Address} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Address} is neither a variable nor a valid address} \ErrTerm{domain\_error(socket\_address, Address)} \ErrCond{\texttt{Address} = \texttt{'AF\_UNIX'(E)} or \texttt{'AF\_INET'(E, \_)} or \texttt{Address} = \texttt{'AF\_INET'(\_, E)} and \texttt{E} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Address} = \texttt{'AF\_UNIX'(E)} or \texttt{'AF\_INET'(E, \_)} and \texttt{E} is neither a variable nor an atom} \ErrTerm{type\_error(atom, E)} \ErrCond{\texttt{Address} = \texttt{'AF\_UNIX'(E)} and \texttt{E} is an atom but not a valid pathname} \ErrTerm{domain\_error(os\_path, E)} \ErrCond{\texttt{Address} = \texttt{'AF\_INET'(\_, E)} and \texttt{E} is neither a variable nor an integer} \ErrTerm{type\_error(integer, E)} \ErrCond{\texttt{StreamIn} is not a variable} \ErrTerm{uninstantiation\_error(StreamIn)} \ErrCond{\texttt{StreamOut} is not a variable} \ErrTerm{uninstantiation\_error(StreamOut)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{socket\_listen/2}} \begin{TemplatesOneCol} socket\_listen(+integer, +integer) \end{TemplatesOneCol} \Description \texttt{socket\_listen(Socket, Length)} defines the socket whose descriptor is \texttt{Socket} to have a maximum backlog queue of \texttt{Length} pending connections. This predicate is an interface to the C Unix function \texttt{listen(2)}. \begin{PlErrors} \ErrCond{\texttt{Socket} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Socket} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Socket)} \ErrCond{\texttt{Length} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Length} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Length)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{socket\_accept/4}, \IdxPBD{socket\_accept/3}} \begin{TemplatesOneCol} socket\_accept(+integer, -atom, -stream, -stream)\\ socket\_accept(+integer, -stream, -stream) \end{TemplatesOneCol} \Description \texttt{socket\_accept(Socket, Client, StreamIn, StreamOut)} extracts the first connection to the socket whose descriptor is \texttt{Socket}. If the domain is \texttt{'AF\_INET'}, \texttt{Client} is unified with an atom whose name is the Internet host address in numbers-and-dots notation of the connecting machine. \texttt{StreamIn} is unified with a stream-term associated with the input of the connection (it is an input stream). Reading from this stream gets data from the socket. \texttt{StreamOut} is unified with a stream-term associated with the output of the connection (it is an output stream). Writing to this stream sends data to the socket. The use of \IdxPB{select/5} can be useful \RefSP{select/5}. This predicate is an interface to the C Unix function \texttt{accept(2)}. \texttt{socket\_accept(Socket, StreamIn, StreamOut)} is equivalent to \texttt{socket\_accept(Socket, \_,\\ StreamIn, StreamOut)}. \begin{PlErrors} \ErrCond{\texttt{Socket} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Socket} is neither a variable nor an integer} \ErrTerm{type\_error(integer, Socket)} \ErrCond{\texttt{Client} is not a variable} \ErrTerm{uninstantiation\_error(Client)} \ErrCond{\texttt{StreamIn} is not a variable} \ErrTerm{uninstantiation\_error(StreamIn)} \ErrCond{\texttt{StreamOut} is not a variable} \ErrTerm{uninstantiation\_error(StreamOut)} \ErrCond{an operating system error occurs and the value of the \texttt{os\_error} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{system\_error(\textit{atom explaining the error})} \end{PlErrors} \Portability GNU Prolog predicates. \subsubsection{\IdxPBD{hostname\_address/2}} \begin{TemplatesOneCol} hostname\_address(+atom, ?atom)\\ hostname\_address(?atom, +atom) \end{TemplatesOneCol} \Description \texttt{hostname\_address(HostName, HostAddress)} succeeds if the Internet host address in numbers-and-dots notation of \texttt{HostName} is \texttt{HostAddress}. \texttt{Hostname} can be given as a fully qualified name, or an unqualified name or an alias of the machine. The predicate will fail if the machine name or address cannot be resolved. \begin{PlErrors} \ErrCond{\texttt{HostName} and \texttt{HostAddress} are variables} \ErrTerm{instantiation\_error} \ErrCond{\texttt{HostName} is neither a variable nor an atom} \ErrTerm{type\_error(atom, HostName)} \ErrCond{\texttt{HostAddress} is neither a variable nor an atom} \ErrTerm{type\_error(atom, HostAddress)} \ErrCond{\texttt{Address} is neither a variable nor a valid address} \ErrTerm{domain\_error(socket\_address, Address)} \end{PlErrors} \Portability GNU Prolog predicate. \subsection{Linedit management} The following predicates are only available if the \IdxK{linedit} part of GNU Prolog has been installed. \subsubsection{\IdxPBD{get\_linedit\_prompt/1}} \begin{TemplatesOneCol} get\_linedit\_prompt(?atom) \end{TemplatesOneCol} \Description \texttt{get\_linedit\_prompt(Prompt)} succeeds if \texttt{Prompt} is the current \IdxK{linedit} prompt, e.g. the \Idx{top-level} prompt is \texttt{'| ?-'}. By default all other reads have an empty prompt. \begin{PlErrors} \ErrCond{\texttt{Prompt} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Pred)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{set\_linedit\_prompt/1}} \begin{TemplatesOneCol} set\_linedit\_prompt(+atom) \end{TemplatesOneCol} \Description \texttt{set\_linedit\_prompt(Prompt)} sets the current \IdxK{linedit} prompt to \texttt{Prompt}. This prompt will be displayed for reads from a terminal (except for \Idx{top-level} reads). \begin{PlErrors} \ErrCond{\texttt{Prompt} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Prompt} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Pred)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{add\_linedit\_completion/1}} \begin{TemplatesOneCol} add\_linedit\_completion(+atom) \end{TemplatesOneCol} \Description \texttt{add\_linedit\_completion(Word)} adds \texttt{Word} in the list of \Idx{completion} words maintained by \IdxK{linedit} \RefSP{The-line-editor}. Only words containing letters, digits and the underscore character are added (if \texttt{Word} does not respect this restriction the predicate fails). \begin{PlErrors} \ErrCond{\texttt{Word} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Word} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Word)} \end{PlErrors} \Portability GNU Prolog predicate. \subsubsection{\IdxPBD{find\_linedit\_completion/2}} \begin{TemplatesOneCol} find\_linedit\_completion(+atom, ?atom) \end{TemplatesOneCol} \Description \texttt{find\_linedit\_completion(Prefix, Word)} succeeds if \texttt{Word} is a word beginning by \texttt{Prefix} and belongs to the list of \Idx{completion} words maintained by \IdxK{linedit} \RefSP{The-line-editor}. This predicate is re-executable on backtracking. \begin{PlErrors} \ErrCond{\texttt{Prefix} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Prefix} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Prefix)} \ErrCond{\texttt{Word} is neither a variable nor an atom} \ErrTerm{type\_error(atom, Word)} \end{PlErrors} \Portability GNU Prolog predicate. %\subsection{Source reader facility} % \subsubsection{Introduction} % To be written... % \subsubsection{\IdxPBD{sr\_open/3}} % \subsubsection{\IdxPBD{sr\_change\_options/2}} % \subsubsection{\IdxPBD{sr\_close/1}} % \subsubsection{\IdxPBD{sr\_read\_term/4}} % \subsubsection{\IdxPBD{sr\_current\_descriptor/1}} % \subsubsection{\IdxPBD{sr\_get\_stream/2}} % \subsubsection{\IdxPBD{sr\_get\_module/3}} % \subsubsection{\IdxPBD{sr\_get\_file\_name/2}} % \subsubsection{\IdxPBD{sr\_get\_position/3}} % \subsubsection{\IdxPBD{sr\_get\_include\_list/2}} % \subsubsection{\IdxPBD{sr\_get\_include\_stream\_list/2}} % \subsubsection{\IdxPBD{sr\_get\_size\_counters/3}} % \subsubsection{\IdxPBD{sr\_get\_error\_counters/3}} % \subsubsection{\IdxPBD{sr\_set\_error\_counters/3}} % \subsubsection{\IdxPBD{sr\_error\_from\_exception/2}} % \subsubsection{\IdxPBD{sr\_write\_message/8}, % \IdxPBD{sr\_write\_message/6}, % \IdxPBD{sr\_write\_message/4}} % \subsubsection{\IdxPBD{sr\_write\_error/6}, % \IdxPBD{sr\_write\_error/4}, % \IdxPBD{sr\_write\_error/2}} %HEVEA\cutend ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/.gitignore������������������������������������������������������������������������0000644�0001750�0001750�00000000356�13021361015�014053� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������*.aux *.toc *.ind *.idx *.log *.ilg *.dvi *.hind *.haux *.htoc *.def *.out *.chw TO_DO LocalStuff gprolog.html gprolog.chm gprolog.pdf gprolog.ps version_no.tex html_node/gprolog*.* html_node/*.html html_node/*_motif.gif html_node/*.png ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/cover.tex�������������������������������������������������������������������������0000644�0001750�0001750�00000003227�13021324543�013730� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\pagestyle{empty} \setlength{\parskip}{0pt} %BEGIN LATEX ~ \vspace{4cm} %END LATEX %HEVEA\begin{center}\begin{bgcolor}{part}\begin{center} {\huge\bf GNU PROLOG} %BEGIN LATEX \vspace{3mm} %END LATEX \rule[2mm]{\linewidth}{2mm} %BEGIN LATEX \begin{flushright} %END LATEX {\Large A Native Prolog Compiler with Constraint Solving over Finite Domains Edition 1.44, for GNU Prolog version \input{version_no}\\ \today } %BEGIN LATEX \end{flushright} \vspace{5cm} \InsertImage[width=4cm]{logo} \vspace{5cm} %END LATEX {\Large\bf by \MyUrlHtml{http://cri-dist.univ-paris1.fr/diaz}{Daniel Diaz}} \rule[2mm]{\linewidth}{1mm} %HEVEA\end{center}\end{bgcolor}\end{center}\InsertImage[width=4cm]{logo} \newpage %BEGIN LATEX ~ \vspace{17cm} %END LATEX \setlength{\parskip}{\saveparskip} %HEVEA\anchor{copyright} \input{copyright} Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. Permission is granted to copy and distribute modified versions of this manual under the conditions for verbatim copying, provided that the entire resulting derived work is distributed under the terms of a permission notice identical to this one. Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the \MyUrl{http://www.fsf.org/}{Free Software Foundation}, 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. %HEVEA\rule[2mm]{\linewidth}{1mm} \newpage \pagestyle{fancy} %BEGIN LATEX \setcounter{page}{1} %END LATEX �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/version_no.tex��������������������������������������������������������������������0000644�0001750�0001750�00000000006�13020764173�014771� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������1.4.5 ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/hevea.sty�������������������������������������������������������������������������0000644�0001750�0001750�00000005762�13021324543�013727� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% hevea : hevea.sty % This is a very basic style file for latex document to be processed % with hevea. It contains definitions of LaTeX environment which are % processed in a special way by the translator. % Mostly : % - latexonly, not processed by hevea, processed by latex. % - htmlonly , the reverse. % - rawhtml, to include raw HTML in hevea output. % - toimage, to send text to the image file. % The package also provides hevea logos, html related commands (ahref % etc.), void cutting and image commands. \NeedsTeXFormat{LaTeX2e} \ProvidesPackage{hevea}[2002/01/11] \RequirePackage{comment} \newif\ifhevea\heveafalse \@ifundefined{ifimagen}{\newif\ifimagen\imagenfalse} \makeatletter% \newcommand{\heveasmup}[2]{% \raise #1\hbox{$\m@th$% \csname S@\f@size\endcsname \fontsize\sf@size 0% \math@fontsfalse\selectfont #2% }}% \DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}% \DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}% \DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}} %%%%%%%%% Hyperlinks hevea style \newcommand{\ahref}[2]{{#2}} \newcommand{\ahrefloc}[2]{{#2}} \newcommand{\aname}[2]{{#2}} \newcommand{\ahrefurl}[1]{\texttt{#1}} \newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}} \newcommand{\mailto}[1]{\texttt{#1}} \newcommand{\imgsrc}[2][]{} \newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1} \AtBeginDocument {\@ifundefined{url} {%url package is not loaded \let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref} {}} %% Void cutting instructions \newcounter{cuttingdepth} \newcommand{\tocnumber}{} \newcommand{\notocnumber}{} \newcommand{\cuttingunit}{} \newcommand{\cutdef}[2][]{} \newcommand{\cuthere}[2]{} \newcommand{\cutend}{} \newcommand{\htmlhead}[1]{} \newcommand{\htmlfoot}[1]{} \newcommand{\htmlprefix}[1]{} \newenvironment{cutflow}[1]{}{} \newcommand{\cutname}[1]{} \newcommand{\toplinks}[3]{} \newcommand{\setlinkstext}[3]{} \newcommand{\flushdef}[1]{} \newcommand{\footnoteflush}[1]{} %%%% Html only \excludecomment{rawhtml} \newcommand{\rawhtmlinput}[1]{} \excludecomment{htmlonly} %%%% Latex only \newenvironment{latexonly}{}{} \newenvironment{verblatex}{}{} %%%% Image file stuff \def\toimage{\endgroup} \def\endtoimage{\begingroup\def\@currenvir{toimage}} \def\verbimage{\endgroup} \def\endverbimage{\begingroup\def\@currenvir{verbimage}} \newcommand{\imageflush}[1][]{} %%% Bgcolor definition \newsavebox{\@bgcolorbin} \newenvironment{bgcolor}[2][] {\newcommand{\@mycolor}{#2}\begin{lrbox}{\@bgcolorbin}\vbox\bgroup} {\egroup\end{lrbox}% \begin{flushleft}% \colorbox{\@mycolor}{\usebox{\@bgcolorbin}}% \end{flushleft}} %%% Style sheets macros, defined as no-ops \newcommand{\newstyle}[2]{} \newcommand{\addstyle}[1]{} \newcommand{\setenvclass}[2]{} \newcommand{\getenvclass}[1]{} \newcommand{\loadcssfile}[1]{} \newenvironment{divstyle}[1]{}{} \newenvironment{cellstyle}[2]{}{} \newif\ifexternalcss %%% Postlude \makeatother ��������������gprolog-1.4.5/doc/logo.png��������������������������������������������������������������������������0000644�0001750�0001750�00000035057�13021352245�013544� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‰PNG  ��� IHDR���–���–���<qâ���bKGD�ÿ�ÿ�ÿ ½§“��� pHYs���H���H�FÉk>��9mIDATxÚíyœE¹÷¿ÕÝg?³/™%3“ÉžIB–$ì‹‚âäeD¹WQQ¹rEY¼" ¨.z•ÂbX’uB&™I&™}Ÿ³v×ûGŸ“Ó§§Ï™%3É€ó›OºOwuuwÕožç©§ªž‚)La ô LaÒ@r€|Àí R¡zÈ3âÌöðg`ãh3›Â¿àNlšÐ(sTË]¹sˆª‚ùb†/Ws* z¼ŠúæMñ§¢=²u´š"ÖGêÞM£J¨ÌFp°pãñÍg‰w6 ½TûÊQ‚3E‡ ¸[Qq GH¬þñrÏ6ùM c´/0E¬/ü€(ÄEP R!<”á¡T«f:Ùj)³´JÜîxýã×4piÜ»�—43“{ÿ@ ê6ÞÙöýJ$ícy¹)bMn¸@%OñS‹—Zá¦J«eº($O›ÇÄ£T‘+Jñ+Ex•�?¨9 $(t#=cE‚‚¹éTLr!M3š6üZÿv¬-c}ñ)ã}rÁT‡jÕi³¨v-d¶:¥·RK” n*H/H›4÷`V¬À$NR/j$¤TâAIcËx·P\#xý"ý’p;¿âcý)‰µ ’”<àQr™‡‚Kx˜«–0K­`ZÁB¥€|×A¨JŠvªè€!AKþÆ$AŠLÒöÀ$©’ÄJÊ ÄÀ„è�Ä ×ËèÆ›ŒëÃí<äå¨0E¬ñƒÀl®ç~%H¥pS ä²PÉwÕ2S­ V hó(ÀªÕ‘/= } ý`h— "I“8&’dJB÷&Â$£ˆ€x?Ä£ tºP»\xÚ=ÕZ.Õ¢˜H—¡?zÿ†Gûúï.û‘`ŠX£‡†)4Ê…ÊB4ŽnÏAÌpÏ£FN‰ZI€<\Z-AÃ2�Lòè†I”ˆLI 0ôté3âÚµ%Tw”í×ë ¹7qxá4Š¼>ÊK‚TÎÉaÆò4—F èÅëópíµ_ÕѾIÏxÒ”å SƒxѨnj„ \ºçr”ZD…6‹CÔjpÍ÷!&aöª.‡½}sR_Y!¦Õµ] µ*¸›¼ý* Œ<Š /3ò™5+‡9sò8ñÄrÌÿ‘øÅòÛüÿˆÇwÜñNóu×=ÿ±XÌX;^ø¯L¬�‰æºpTr¨^*„‡­šyJÅêtkåxÕ|Ú,üä£JI"éI©«½{R¶<YI¤XŽû€(ÐjXìuìÓÈíwQ£(0ÜTGr˜^2À¬ª<‚7Á ŠÛ£à÷k¤ªÕjÂ[Íxów<®òðÃZ¾ò•¿_80{!ñÚズ*L6x|4ác‘И&|,vÏ¢R)&ß=ŸÙ"ZI®RŠ_â‘n ß,鸄¨L'aX èÄÆ•@"‘(i…G@íx›T¼Í*î6…Ú`"‡åE¥|•…>¦Õø(Íó’_àÂëS]8Ë<‰)Òì„2¿Äo‰”’—_nì¼õÖ×oˆ=7ÞÿQ!V²$UeÀ1®éLsÍb¦{>óDù®ù¸”"ušÔÀPÀp%ÈÃPÕ¥ëc –„ɛà 6‚¨µYa‘/ŸRÍËbO!ÕÅ~fÏÌaæÒ Ó+|hš@QÀ嶧Z·ˆíÓ­û¤ª³*#+¹Ì<š›ûõë¯å·[¶tÝ7Qòá€À…¤(RT šð2[-¦V+g¶RD­RH¹k®éçñÇÐ-*ÅÜg³{’€‘µ¸˜*k€½êË×­âïÕvjG½”G|LR ¸9ìàBÌϧ¢ÌË-P‰Ë Š’|b&e³Æ$™ÕžÕ‹eUƒ.º» yæ™ùÃ+¯4QJÙ5Õ5i%–â) ÊÕJ®2vÕ°Ô³”R­†<‘¢Í&_úÀð™ŽBÃg¶¸t bd&аÒÇZWq`að·jx =øî�ó<yäknªJüL¯öSyP@P%˜cnšK.Â$Îd²¾U&9i%“õe“dJæ¥âDÊîî¨ñƒüó•—_Þõ `BH““X(P‚œ£95°‚£ýÇQèZ‚[æ‚ÌX¢™>˜ØÇI(ž2 G­º,u%v�€X'ȹ9¨ €…yyÌÊÉ¡¢ÜOA…›Å+òq¹>¿ŠÏ§¢¨IÆþô¸åx$„’Œü ¬*O’’VÎÒNבO<Q¿ã¾ûÖ_ 4Mt%N¸PX¤¹<°‚órÏ¡Ð{Ä]&‘b˜[ ‘ê8Ìú…áÄÍý¦ÑìéPð¶¨xûUæEò(Š¹©êÉeöœ êrY²´Â"7C¥L&2@fòØ¥N&‚¶tØ>È®ú’9*O=ÕÔvÙe/]ØÙùûDWædXn‡¸Êø|àNÏ=Ÿr¥%î…¾Dk,J:™†I±ì[h}‚`‹`¯F _£?yÒE]¼€ŠR5efÌÏ!èw‘›§âñAt"Ež8™ÎG¼áÈçtìD¦TkohZ”‚×_o¼öÚ׿ÕÕyiTê&Vµâãòà©\œ9UJÄ<¦Š‹X5„LñÔ^éx¶)¨]Ïf•iA/³‚9,Î+`zžŸŠbµ~Šs<s5ÜA^¾ÛR V“Ý H#US#!ÕH¯Y÷v8©>HÙSö´ ¥ÂŽ±ÿø7îmhèû-ûб<U(ЀOxæsKÉ·™ïZ ÍÔTR„Ú[T1 ”5×fAuGYU9Ì3ò¨*P7?—âbK ‰PÌÖ–É m¥Žåx_Ó9ííÕdm’Z=êVõ§Yö:_üâ<öXÃe¤û)&û]b©ÅÔ`ðü ùlþWñE|fk=„…P &Ëê!o“›ëó8¢°„C³üòR =xÜW ª’:VÓ}$ Î?Òk£‘\dÉß~ìá°e»®‰H®¿þçþüçÆؤ‚ýK,¯ó«Yá=×€j*„)”$À h«åoû9-¿’ÓΡŸ*¦¼Â“ ‘ÕÒ²«²ÑT¾Ó¹±Jž‘äoÝgJg?N›}Kª¾LäRˆF‘>øÁö‡þà‘ˆÞ°êwÈ›ì/¬ðÌÊî¤L¯A ÓÆŽ`RxŠŸôòÕÃê¸ðÓµTUûдäEé°‰ld¸¶/ÇÖ|Òa»f¾“ʉPIu—ümíH¶ª>ÍvìæÙg[BçŸÿÊ ==Ñ72Ÿpì‰ån®žÄŠJN$?Õp‹&S4BÁoÝ\š7—ÿÅB¦Ms#„“|8)5Ñì¾õѺœöNù$Ÿ5ZIgw|Z%”ýZ&"ª<ÿ|Kß•W¾~mOOô ­Ù,˜hb©ÂÅyçsCÁuä„sͤêc�\U8~]_ûÔbVWŒßŸtwÛÇ 8íaäÄ­zÌ–v¤ÏÍvìôœ»h “'ÝnÌ××D~üã 45 þ~‚ë6+&Rj(\”ÿîÈ¿ž`$ú1%•Ðywº¹ººŽ/_:ÒiîÄ•´n`RD²«¿lR‹,ç ;‘2å9œž£5Øí­?s\áPÕ§’˜"¸ˆÅÜœsÎk{æ™æ‹t]¶M`Ý‹‰”XÇWpsÑO "•°¦ÝàãÁkVrÒI¥hZÒd%T&h'•`ÖãLD %M2ŸLöÏH¥£Hg½fWuÖîëÖÎLÛ×'ùêWWÿóþg×…RŽ~àxcü‰%@+å÷,~QôÊ0Õ_’Tê«‚Cž-âÖoÎñÇ#DZoCÉ•IbÖ~trf2¤÷µe9ܱÓ> ŶO˜Ò)QÀi×á°”?ܸå±Çv\3H#±üŠ[‹¾ÅÜøtDÒP7�Þ€ãþZÎí_;œÅå’"”u³“+S+p$†6¶û³t¤d‹­6\ÿ8äÉóÖôCm°ÿû¿¶Ž[nÙtÃÀ€¾jêsLob¹„ ÿŠ2(-6Uñ›bî»ûhjj¼¤w';ÙVÙH•„“1ë¤63I©ÑÚfF†çg_ÙÓdBR*%åY‘ú-¥I()V¯îÕ¿ò•µßÞµ+ôÔ8×å>a|‰¥rjÁe\íù$Z¿4U`\� Pý³�?ûÎ2ª«}¤“Ê®­½ƒÃù«¬…ïD&»Ý4œ´ÊÔ(€ì¤ÎDëïLi(¤„pX'‘ôõÅéë3ؾ]£¥E¡«Kåí·§±ys![·Ä"‘ç ‡c¿#ÑО,Ob•»§óÕÜ+ÑBªÅ¥ÐU¿ p×çâ˜cŠH ~±“Ê*¹2I–!UÀPRd“NÆ0ç {c�²“#±Ò¿AJÁà A8,éé†`ýz•æfÍÍ~jèè(¤©©–ÁÁBº»kœF$’ih 7= ñÿÀT “ ãE,Eø87ÿ ,O3II£û W͜ϩ§–“Ù¦J’̩­•n¯¤‘¨7»ƒt‰6©CUS&YÓKs¦²H †!xá…­­’5k¶oŸOgg9|pѨÞÞ:¢ÑiÄbe˜1?’sAÛ³¢~ý üþ Çeàxc¼ˆU8–/ùÏ›ìPÖ¶Ái*¹êŽù —‚UBÅ-{»¤J[‘I%fjÕÙ‰é¤&3ÒUW&‰e’Í0 1ˆÅ$Ѩäí·ÝD£‚íÛ]lØPÆæÍå¬][IG‡8(‘²©F <Ü·Ýá­ãTãŽq!–âçâœs©æ@H&ü @Ù/}ÜôíCÉË·{ӓıÍ6<“TÁ’ÖnSDf"”]ZuuÅô÷Cs³—ÎNÛ·hoÏaÓ¦š›‹ik+¢«k†áa``†‘‹)}ŒHVÄ—»ák_†¾ý2`o¬bûç*×1¦Á¤�í W.žÇ¢E¹a ga·§ìC]ì„q"…¬ŽÄáŒiépi4‡Bº.‰D ±vî”lØࢽ]eÓ¦£ioŸN[ÛLz{+ ‡ ¬Â0ü˜!|˜s`÷³$c˜ã‡zuXMýpïÐ÷l¢à&-öX‚+ò¿DI,ÇõhÃÞ.æk·Õ% vBÙ võ—É] ÖVbrsj‘™×  Cb’ÎNÉ{ïI6mÒéê’¼þú2:: Ø´i±X-†QƒaÌGÊ¢DqYûïöÖr閰΀v ›ux-ìÙk×C¸Xzô7™ä¤‚}'V¹{&g»—#zdj$™÷•ËVÌ!7O%=øŽ½h·uÀÙöî•PX'6èï‹‹élØ࣭M£½ÝÍÚµìÞ˦MÓ…J‡!™®'"wì탮Ô8ÐKjî|}ôF¡±šZ`k3¬o‚6¿z;D¶‘šú&ûÕ¤Ä>K¨Ôå]Äœä„ K¶rÒ§*C_†ëÿs²§ìös‡#}}}’¶î(]Û¢Ôo £÷I\­q¶·Ôò÷§im]L(TD8\ˆÙ\÷bF铘úc[”°c¡~�B°k lÝ ÝÐõ>Dz¡o7¦«¯7qó¸ÅM˜ Øb)j§zŽ$'9N]b œ8­‚ʪ¤wÝi¾q6¯wòzRÚ;“jã†0?úI?3rçøŸ·võ³("96")—fCý>>Ë:nÂ÷Að.°ø'ÐÑ ï@s=ìÜFD› ´Sd'G^¤È“ ûB¬R÷Žµ©±êà\ãì«f i™Z}N$ƒÌÝ6)H)Ùµ+Æo0èì=‹ë¿{5³¥Dü툞ÕCÒÏ¡‰\úè&w„Ÿ$1…G“ -Qh¶„uøÛ»ÐÚ ëwþO;ÁXƒé Ìþòÿb;±TæùŽaŽ´ŒWï‡SE%uu¹ míe“RØÎýÇ–¢üä¶>vÚÕœ|ò ø}Åàð#`ËPby¡ééH’' tcz°û`×�4÷ÖÍÐÙ Mj‚Ð.èÛñÐŽù4é<Ý“ c&–šC{1…qa†ù‘ ¸Ö+œ~to¦~;«1n%’=¶A:¤”44DyðÁj®úâ¯X\W¢$Ô›ÏGy Ù›s˜Î h¦ðrÚ X…æMе ¶¾ ¡.7Â` „Z1ã$ÛùS#ÆJ,¡–rŒ6m@&¬!¾×TŽ¹²!œÔ^&§¤•TÎèîѹýv/_þÒÌ›_3äzdÙ2¢y…¼Õ¾;Ú ÆVˆ®MÍlìleÉ ú€ç@¶ƒ\mÚâÆc&–{&ÉÜ”yN7TFüÌšÀY çÜÌœæÞŸ·³ø³N®‡Ù³@3=Ø===üñÏ =ñè#kÖv·­î…¿Å¡3;Ø;¸B†@Nz¿ÏG c%–ªUQ-sÌ°A Ž(+±Å{Ζʔ6…ÖÖ8ëïnçö–8Ú•W·¿–ö耼þúëû~ä÷ßè}hÆÁq8%– ÆF,Á¥W2˜�M°°$Eqr)dš E†s)Üw'´Æ)س ®½šö7Öòï‘ŽþGþôØUº®ÿž¡fü‡c%V§%“†›óól ‡“JÙIÕÖ®³öOÝü»õR,Ì¿¿+ô8ò»º”S¤š¤›ÛYR‹ÍÚ†ýE7/fVmNÙÕ`G§ÎâmÑ4öG€Ç¥±&$å“L‘jÒblÄÔx– {Y¹=.ªŠ‚YnrêšÉ.±š¶…™3î7oÖÃjiÚTS˜¤³K¸ÓéàQU~WâWæ!¹Ù‡ïÚƒÒ`¼©×Ü‹ÅûûßDNµô&3ö­:ëU9Êóù{½ˆ_ý>2uîõ× ®¸¢þþýWJS5`D¿á ¦½.̘±÷\n[›Ks¹�>pï>…á0^#Öh’Iž‰a®§P^!illH;·`ÁQZZµsàÔ&)ÆJ¬p|'Rˆ=zd”¦ÝIõ䎇kN¿S(-qñÆD×Sæ”ÏçãÄO\!„8ô@Þ2c¬Äz/Ö@TIKBtšAŸ‘mΤÈrN8^/)Q)-ÝΦM›öžSU•K.8·|Þôª€ê]€SpÆXýXÙ‹´Žþ…ã´µD‚Ç bDçTUpå•ÜvÛm„B!ód_œÃ~F¹³½ëØR¸(:Ð…8…¡ë|¤÷ ¾ì9OÄHÌmV%uõùœpD™eHr¦Y6Ö‘ I$¯§¬¨Hãõ×7!:ætðéóO?Dm<¢3ß3»a0­˜=L®æ&4>“(’k«°Sï`P„ÉU“9aõžv Ô4Î!¤í›áf(®¸ÂÇϾûmf¿bnã–½w < óžv¹îxqÙ²weeeZ!`Ý:X¿þ@óx % õë c#„Wƒh:Ðo• c%–Œí`½è¥L-LŒ¨ÊƒµÝ]ÄãVbY—8ËB:‰d±¡½43gºù·Kû¸ÕNnÀœ½—¼³øÅ¥ÏÜ|ëryÐÂôÜÜtÓG…Xa ñlØ0ÿ»^| ºžƒø_0‡Mªî­±«×e+'º M}÷@ïÌ(/¾Ô©§”’¾F^&’Yg[m²ô2BpÒI¹¸ªáüsøyKœRäҪ瑷häç yQ·û@ñx¢L#‚pñBh[O]lƒW€Èƒ|ŸIB°±Ïù6(ò.ácêB<{׺ñJ*_ðsü±åà Ÿq‚ÝÞŠêj7sOÈáÎQšw؇âÌsá̃:T•>ÿ<¼òÊ.æñ†Àtã*à¬�|òÐÏ‚–™Ðߢƒý´´I&Œ™X2Z!ŸðGaTML¨ÈƒÎ?D8ï¸ÙVÕæ4ö*-7œ}]éé„€Š Ÿ¤qŽ›ßµêlëWP–Ÿ g"¥$‰ìÝ¢Ñ/¼aÕª済Û%¹(¸3æÄÚ 'aåa œ ;Ja°\ØÈ}™pç÷,à¾ià3ýEæ¬Ë8 <.ø]ù±|æÜ*†.—iQ8«ô¶ŸsúÇ3Ò`pPçÝwB¼½Z§qg%%s°’WغU²c8KÁÉ=¾´­Mðþû5ÄãK€Ã1#Ô¸†¹+ <oÀ ÍðχØÏËÀ>Î!W||¡ôvîà¸z0gâÑgß[Ãý·CnnòC“ñ¯ì×ì,’°«Q{X£tRJiòÒšÖ×êΰG§¡£0Æk’k¦¢™&¤Î† ’¬^çÍ7kÖäñþûGÓÐp:áð‘À œ‰&µq—wü4Ý�¬§ö)®ŽÔPƒ|:p9qêнïÅX™WFuµŸt+“*´ÃÞŠ´ùHÏK‰¢€ªJÛ–<g$Ž±œ·¦‰ ÛñxlÂòLayžõYÂñ4 ¼^˜9SeåJ…},ʧ>UÏâÅÃç{–žž z1Œ|ÌÖòr‡+pÈlØqìÚF=ûɸß×€MÑ-,.¼”ƒtOB èSbø^Õ8yyeba%§Q¢Ã}ŸSgõ(Ær ¹nµã¬{kkU™€ÍippþçÉtÎ„Û ‚¥Kÿx/'žø••O³qãjò™¤Ûc*P«Àñ%Ðu:¼ß¼¿ZŽû Ì GU¸È{ B ©U ÛþÑÇÊ‚¤Ô²Âà Ëo;œ ÛpHï´ÎL¦¥Cœ*{"¶ÑOe(ù²å .TT(¬\©óÙÏîÀç{”÷ß_G(´³—ËZ&ùÎtCÇið~Ä^Dz”ÑD`_‰ÐofYÎ Ì…˜!Ö4Uè4ýf€³N©Mø’2I+œ†.ÔÁ:ܾSÅÙI6ÒÊ­Är"›E–û•Œß Âòå*'žXOsó347ljÅæ`F´âx ŠUå~™ 4êǃX†ÑO§+ŸûŽÄ·WjåÃŽÆ~J7ú8ôÐbË|ÃáIúØ T2”lNjd¸ -éFò,‘åX\©ïVU¨¬œvÚ�¯±aÃ;ôöEz¨& X¢Aéx.b«˜ PãA,ìÒ÷pXðæ‹i‰°jŒƒaãƒ=,Ÿ^Nåt«!ŸºÑYrYí{«ÊZðÖ4C‰38÷ÞÛË?þbùò�BX—¸µ’bèf*ÿügŒU«¢lØϸµµIfÌðàD]Wyê©¿ÿý�ÕÕ ]ŒŒxÙ$Wv‚ùý‚£–ydë×?Æ®]K€ZK 8Dÿx© âo1~—ñ ¥pTî™<Zp;Õ}.3žKëá”Ç+ùíË™Væ"áÏîvprAd‹Rƒ%mÒµ�Ö #7†8ãŒFJKU^|qF¢7ÀöÚJ²o3ýZ¿ÁYgí䥗²÷ó~îs¹Ü{o¹ãµ¾>O~rk×Fxî¹*–.MÆ'n>@¦ù˜™&‹!¥¤¹Yré¥%¼ð Äbç‘îš×vÀýßø¯Ç{àÄxF$s+>¾W~/ßæx“Xý˜¯ë~J᢭³ùÙOø¶ìË8Å(.’S”šôXîÿ{gŸ½—K0¾=è¬Yy眓ÇW¿šTÕ–bIx ‹ŽŽl.Y¹2À±Ç¯µ´ÄYºô¦MÓxúé*¦O·ÏbrjÈØIçg¸Pã©´;wJn¹ÅÇo~s=±Øe¤“kpU#üéàµqä¸N¦ˆ!~Õ~#Ÿ._Ì_±IA z†ÁOÔSû‹ ×]·(á‚HBþß’üm?jfc•^"ñ)é…__o.°jÕÐVª çWˆ¢ -·[òùÏ?†Ð㱫eö¾Wss”––8‡âÃïw Ùýr¯W ’ÃpǨ©iy¦//gíä·–Mªì¦O‡ÿ8L8ü-|0)Ï·ä_ÜZ ¯Ýmg`ŽiŒ§ÄJbYÎÇy¶èv BAè!±J…í[‚Ÿ³ŒË>?·ÛªþœfrZVÎZ™â@¤ÈvÉ%[ùË_ºxì±9¬X‘c{M³ËÇå1´î½·…+®ØžõCgÎôðÌ3s™?ß›–orÏ=m\yecÆû««]¼ûî 5ÛýÃ…!p’Tz†sÉô‚+¼öÚ¯‘òÒ«þ>õ ¸ŽDʾbü§)¼9ð2·xäûþ/ˆkægEÄ¿+ùÞ/ߣçÎ_¼tyù.RJ.½¬ÿyÖa6™"Õ¤ 0ic¼ûî�}}:W\± ¯whGî´i.|ÅÅC‹!UX¹rè0œ$ ø(+óáÔ2Ÿo6¸>8@NÎÐ¥w—,ñâóÙïur«8}¯µLì-a¡C$÷ßßËW|“_¬�[ò?VÀÅçÁ}Ï@ìÿÆÃ: á!W ðãâë¸Ü}!jr…Õ(@/øžT¹`×,n¿uÁ LÄ‚w Ñmˆ³½ ­�mmQæÍ[M8lØ*/Uuu~^ziq*:`2…„hÔŒŸ—K iÎ$èïsæ™›xñÅêëfæ̤ç‚ÜúîÙŸ™ÚÛËÅòܱÚÄ‹/ƹ袕ìÜùéöÖ:àܧ þ³ ïs(Ì !Vyjÿ]ùgiʘÒ�ñ|rM5·}û0fÏIkK®­c7ÆGb̧WÊóÏwò‰O¬å{ß«åßÝdž¦¦ßùÎìÞÝ9}Í5Ó9ýt«–z­[9ýôõD£ëÖ-%T*ytœUyÚÏ95Zœb駧‰Ç¿øE„¯ýûÀÕ¤”–Ü‚o]ñGöµò'r&tÞÅe»¿À£¥·rLðXT!Ì1´ä9ð?µM¬ÿaß;y)Ÿ<³šÜܤjLLÒHµÛöÂZ1ëׇÐuX²$ᇚ¤£­-Ä{ï Ðߟ½ ^\ì³äþÍÍ:ÍÍQN8!—+™Æ·ÞEêŸ Ró­È¤“×ìNa;¬jQ¢ið…/xøÇ?îäÙgEÊäôL8ß¿û¼÷ûè8H‰•Ä÷,î,ý!')+P³¥ 켧Ý||çt¾~ùB–.ÍO¬–Mb ?xðƒÙ±#Ä¡‡æ’—7ºÿŸ¦¦á˵¶Ö‡ÇcwàšïØÞáÝw{©¨pQWçOÌ\²7D’°’+ì.'Éå´þczYJ)xûíguMMwy–÷¸¸ê ÷±ÆÖþ @ðñãi·pžïÓ0(Lrí]ÖWë¡ú¡�ÍœÍ5W×% j'iå$µ€¬¶ÉD![‹Í®¦¬-µL*ÜêèÍç2§ÖaܶO½‡a¾ÿ}[n¹]?Ý’¿Ô½[Î�vµdƧKgxôçéç)ÓTæúçàÖ|–…9"¢ç„¯FZøíO·Ò½M'èr“—çÅí±v…¨Çj†ã‰èé³2už; rš`2œügNrªzSÏBR^å¹çZhk;›”U¤�ž<øÛ`lk…ï/b9Äæ¥X{bkX˜³€w ¨Ò"Ü3``yœWiá™vñúómôîÒñ(.@Åëu¡(ö uêÔJ†}Ýœ:ž‡ë×ËfÿX+K^#™)_§A‘CDzåå)ìÙ³›W_] TY®ù5x¦ºÿ1öõì/U¸î™(ÑíšÎŠ®æ(ÿ¿¡FÜ©):˜ó÷u Ü«Š›½ÌlËa‘^H]]>Ç]ÂüùùY Ô ¡.3©$« ÀÉæ±;€Í¼TUàrIe$jÑêu·› ÖV¶µo6ý]׬‰sÄçþ’TC$\ò<v°k,¥²ß‰••¯–suÑרQADTÓו$ØÞòVèÀÀ ó€¾ý˜Q$Š8Ûu6¹¶5~B¡Tш߳‘£ŽÑ8îÄ�99Î=C‘‰ÔVBµµÂaÉÅ{xì±×I—Z¿€k.…ðccùÆK,S_ÍVóùJî™|*xeÚA(1¹¨fŒÔPÖÿïaµË$Ç<eÏ=K­Z›v^×uúÞßFË™çóRÛ»¬]èãÐËŠù·ó ÈÏÎj±;íÒѹ•(¥äÉ'c|ö³?"¾Ê’ß: Ÿ¸v\3–oÜŸ6–  ]†y>¼†W_"®o¡Ú[€×Wˆâr¥GÆHZM{­˜DY ™:þ0lÅ¢˜ }R ¤†¢(x7l¦øá{8´¯ŸEÍ1Ö?ßÇ7…Y|”Ù-”Yx9Íròù¥Û\B@uµà·¿uÑÓsæ<E�MÀË…ðÁ]–ŒFŒM¬$â@“1À³‘õ<Ó÷'Z#¯R®tQ(AørÁ-ÌOvc®ºìÆ$›“pVòi‰Ó†ÙÆËœ·›ñÉjÍ„b¥˜ ýC‰ÀSÏÀÓ©““nsû»ƒ,>.‡‚üÑT™“¯o¨›CÓàí·c¬[w|'?ðŽÞxœ10©c9ÀaÓà;Üz—ƒÚoç\ßbŽÌ9‰ÚL ýu¸2¹OŠnb^ÓyoŸ é4æ� ¦Æhêmòo-#Qr^ú%z4MÛ/r_êç¶ËwðÍû«©®²ö$ØÝöNiHµ4“Ô7ÒîS8æ˜{¬xܪžOòÀÏKL&±R0Ðé—°JÆysà ÊW3]ñs°ZD±µí8nÒLÏÎÔ ¸“\¢^‚K¤w5©†¡•ìÙsÒ¹pÈyà+&E¹E5œP}2ÿõ_/ò“»2t~Û}aöNÆ©y}ÆŒrs? ³ó˵Å°`,e1Y‰e…ì’qvé½¼©÷è×ÙwD‰²íCÎ{€­pç›pÚ“ðóG °•KQï½›O¬\Ê›?¸_|Š“N²Ž/³LB8ì‡åÌ™£¨h+É„�9sºµ‡QÎè·¨ÉSØw$\,íQxä8í3ŠòþÖÓ΃7^„‰;àåºë¾É½÷ÆéîÎæ·Ì6-Çß*UUõ¤÷={“¦1Ú^|¦ˆ5™ñÏ7¤¼æ:w|[¨05Bµ  Å‹/`óf«�Éf�d›o™‚Ë%b¶¼ 2Í6E¬IŒ˜”/=ÿò ®{Ã^?±‚c=•Õ«íêÏÉÍü=|Ÿ¢ß¯PQÑ@úÈd°hfÅQaŠX“ñîî®?=÷Ü?Òì›yóêؽÛM8lƽ/0GÃÙû: `Lvø±&=dÃ˯¼°#Mf TUD(4šþa'©5q]†Vá¿:ÂúîÝ;xæ™ù{çÍE£(mÃÍÔr€h=?±˜"Öä‡W®][äÎH óƒR•á–l®‡ý30rŠX“ªO6Œw8å»~<®Lͤ óžhTÒÞní”ÓÞêÓx¬)krCˇ³–ƒ×J¡rfzðùÆZ}CI ìÙco�Æ€u[Ã$Ö)bMbEY~ŒÛsÁÁ¶YïøZ°tpêâÉ4«z(b1Ir¸5}¼“1„öž"ÖäÅ‘+V÷‹?ûB­ïÄÏŒZž™ãañ’LË5f›‡ètl¢§G§©i6fïMaà…ÆýoÊÆš\ð‚¨ óW¬\¹â‡wþâöÊÚÚZ8ô ø^%úCðëîNûR)¥%Ö¡Ù&bdšm–`ãFööY¤Ëš~ r;SÄúP 9¤Ì¸|Pë…Y>˜? J—µâðã¿|ÍìÓN>ÖW\\`KÎ À-?ä¼�o¾ô_ÜsQ%BâpJÇiLþPîؤ¯oŽíì{q`cÀ±&¦(,æ ©¢œ™Ôœþ³—7Q0\µ ÍÍ ¸ç.F;û ð¤÷ûöé1þÝÁRŠ×ë4j! +qœâC Ý CòúëEÄã5¶×1Æ›cùð)bír0;Ô‚ÂC‰P%<ÔC‰RÍQÂ\YH™œË˜&ç¡I ‡Þß¼ÕÁãôæÛ°»fL@JÉî–nî¾ëûœvê›,;<‡¡‘£3©¸Lñ¬÷Àà ä•WæÓ,/ÒŽ¾›†±Ì±†G ±åÅÂO¥ðS+\ä»R'r)Pʨ%D5¹b9º¡ûA÷áCš>M«óûýyæ<JaŸ†´§ÖÖÃŒi„#1^|ñ-žxâ6>sÞ6–/ONÕ·Kª‘ Av ¢b÷Ùgã´´,'=Êòn ›þÊ=©SÄ2‘ /ÈGp‚f¹ë¨Ôæ2Ý5ŸQ‚O)Ç«”á1¨2† ¤/1“Hš[Zt† îňÛyÄ©ìnG¾¼Žú¹µüâW÷ŸÿW¾ù(³g{áž2Á®òœÂ? %\4 O=$ùéòsÕ ìYʼnõ!@5&$ç\x„Fð2…|ª´™. ™®ÍæpµVê,Õ ¢Xã}jØ’· ˜Äœ¶Êíðæ)°Í­PïVhÉU0æúÙS¬‘SãåÒKŠY°ÀGj½žáiÖ5‚²M”º¾Ð»ïÆY¶ì,b±»Iç cNXýÃé@óX û£ &¶€RÈá"_ø˜®3]­d†R ¥”<uAòq«3ñK_Jò 2zæ%¤†À:†.ô±7òI [ÃR)lwS¬»)“^jâ>ÿ–Ê‚CsQ4ƒÃªÜiäæ€×#ñûìOµ¯—î.È<#;S|1Ó)úøã.âq{ÐÛàŸoèkŸâ‡‘X*©&»K¸™-ÜÌÅM’KP›C¥VM…RF‘:Brp‹i&y¤‚¡AÌ"‰öVGÒb˜âLÖcŒ½BAÛ£àiRð4¨ä…\ÌÍËen0—¿ŸÊe.f. ª‚‚@P j’¡Sà“ê.•³ù¥Œ ›pæ=[·ÆùóŸ—#åRÛ¾4Mÿ rÌ+W|xˆ¥p‚PY¡ä“çžËm³ÔéT«³P”ZT¥ÅPAWÁPÌ ’ Ú ùŸÕGñhÑ(b(u»@íå.¡Tñ1_É£¬ÂÇœY9,8>—¢B7ŠŠ"±åí6O¶VNòQÏðbÖ4Na¹63½aÀã{Ù¼ù ̱íVü×fˆ½µ/Õõ¡ –šÏqWó›àg¨Õ=O(®¤/G`Yd ÂŒcÙ jXèÑôiø4¦‡ýÄ=ÌìÏaFy¹³s™{D.Á ¿ß\úÍ ¾fU3öXvbÙƒ¤îÉÔºÃö;SÌgU(¥äwâÜsÏ©èúJK~p°ånÌ ðcÆä'–J¥ÿRît}žýîô5[íE6V£9m$lf»Ý…¿UÃשRèö0Ód¡¯€|Ÿ‹ê’�U>ò½^ò 4¼>ÅŒð,2‘†VþHˆ•Mu%óÒò…‘ÖI^Ãà |ï{EìÞýURÑüÀŒ³vÏF0 ¡î„ÉM,•"Ϲ<¤|™ºn7Â$#¬#n߶� Æ .'Ÿƒr (õy™?'êù~ÊŠ}¸ÜWÁãQ"“¤ˆZŽ‡#“Ó9ƒÌD°þÆr¿})'¯ºý~§0I©tñ8üæ7ž}ö*›m¥ÁºŸ0±Þ'¯»A!WYÎmÚÏùñi(Fòmã‰ÏQ𴪸=.ÊB^Ê£>ÊC~ ú½zX! å±pQ>B€rï– ÖãѤ±Ÿ³ÚK™Zl™¤›ÎPRfjùÙm·L¶•à…¢\tÑ víú‹­úן~ ¶\�rŸW›¬K£†«Œ/sA4„\íÂ;¨’ßî&`hT‰�•ÂO©ô2§*‡âb³åh þ€ŠÛc¸l/— ÖãÑ’.ÓµLÄÊD¼L-¹‘J?§<Ìü7oÖ¹ñÆYìÚu+養w·À¶_3NËÌMFb —K9縣+¾UÖä 4PHu™Ÿ‚J7µ‡äà÷*sT|~—ÛJë–—–­òad$2²\)Á†;示FB@'R9¢Q¸ì²|V­º…ôp sÉ“G~±—Ç­Ç+£ñ‚׫ûË_®xüâ‹ç”(ŠLôÙág*ð‘’'›ú‚‘+Ó³æYÉóÙÈdM#GpìDªT~ð•¯DùíoïÁ0η½ËV`ù[Ðr&ûØ´bRI,ŸO]|Í5‹oûÜçf•¨j¶fsöþ¯á% #H3ÒûÁ>›$éæôíÆ0{sÍÂoôòðÃ7cçØJ|ðõ&hù:ãH*˜DÄ‚ü³Îªýñµ×.:XÓœ‚Àf.<vÉe=Oò@v’Ž†èN׆#a&C~¨¯ª±Qò…/”òüóß!?Ÿôn›àÆ6øûÍ ¼6| ÝÑa²KY¶¬ôg7ÞxðIEEªê¼Hf¦~/'—èXÕžSZ{ÈÅá¤%d'S¶ãLjq8Ûkè?תU:_ÿz·Þº°Æ¼J>óþ<p„ ÄrOŸîÿÚý÷/¿¸¶Ö›Á—ž­ï Ûñp’'™^Œ ­‘°¥Ic1èÈe'†¤ëê’Ü¿Âþç vï¾s±K+"ÀÃ:\{Ä~YàãŽM,¥º:pÞÝwuÝ‚eè’¾#‘XN•�C ÞN${EAö fÇc‘\£¹?ÓuA,o¿­sóÍ•¼ðÂe |RÁî‹À Cì:ÌuJ'”Xyy®£®»nÑ §œRšŸê2¶«ÁL6–•ö†ôÊp²¿2Ùdö{addŽ$vf$dËtÍ’‹„–ƒ»îÒ¹çžÓiiù°¡q‹uà[axà.軑 $@b¹\Jù—¾4ï–Ï}nÆlMKöþé¶$92ÙSÑh,öÎpÏ.=#¸–)=~§ÎG£°y³ÎŸÿìæç?_F{ûÕ€}IÞ$vJ¸>Œ‡ï%ëp@ˆ¥ª¢ôÓŸ®¾ëÚkç/’R*I¬L†»<#q9Œä8“í”f¸ü2å‹C™ÎÙ“ô÷KÚÚ ^yEã¯ÎK/EKËgÐõƒ1;“í¤Š¯Äáû›`ÕwÁxšý@*8�ÄR‘wÊ)eßùÑ}¼°Ð°ØU#±­†³±`ä•=Rb‘!ßl6òÍ”6ýX×á°$†PH°n¼óŽÆºu…lÜx[·žB(t$RÖ’>sÙšWpoîú l¿xoÔoû›XJ]]Îy7ÞXwquµæN-hb•VNã”Fc¸gCF-TmÉa~…”æ`;Ã0ן~ë-hi-[ ³3õë²aCùèz º¾)ë0‰”m8ðœ„ï·Â[ßù(ˆÈpï3ÞØŸÄÅÅîOÝzëâ[>8g’j8Ûj4­ÁѪAáF²·›*É0$ýýƒƒ’þ~صËGW—‹ÆÆ --9¼÷^5ë×O§¯/‡pøHâñiÄb3‘ÒºþÆHW¢c ¥šáñÿ†®_‚CÌïý„ýF¬œmù­·ÖýçÉ'çªjrm/'˜Tû¢Éf8Éã´OB$È#‰D ¿vïÖhmÕ¨¯ÒÑácóæ9´µUÒÚZMooáp}}ÕF�ÈÇœó:ÖjHª¼Ü¿þú ìzXƒé[8`Ø/ÄÒ4QuùåÕ7_rIù UµK*ûd‚LãŠÆB(ëž1¤§•:; Þ~;ÎêÕÍÍ^¶m;”ÎÎr–W–‰ÌÄ0ò1'&WúOt�þÔoü úŸcäð-ö± .¾¸òîïærU “N¨ä±ÕÛnž­õç4ò�‡c'R&Y¤„hÔ ‡pX§£C¥¡ÁC[›‹Ý»½¼ûn5»vðöÛÓ …*òˆÄÌBœc(Œ$¦Ù0l7`mþ²þö þäãxÀ1ÑÄRW¬(øÉu×UŸ˜“)I'³}•­ëÆê§Jþ®ŸŽPÈ ’ôöÂÀ€ ¡ÁOW—‹íÛ󩯯 »;††*z{§ÓÛ;›p¸„px¦ÊòbNYï°b³S8tq [»aÏ�4 Àö04ÕCýFèX ‘·€VÆiPÞD`"Çc¹ÊÊÜŸýÓŸÝ»lY@MŸád_ çV€Ì*,=†A²¥‹A,&¨¯—ìÞ­ðÖ[nv££‚;¢¯¯ŒžžZ"‘<Âá* Se˜˜÷’’9†¹Ôç[Q؇ú´×CÏnØüDB0XáVh5 Jô€dJ''L˜ÄÊÏ×Nè¡y¿\¶Ì«î3DRY§G8ñÆvœ‚”Kt=é…VioWØ°Aa÷î|Ö­›Ç»ïΡ££ ÑL/GÊÃHÅØœ¨`†’tm‰CƒÛtز¶7Áúzhë± Œ[-7ËÌù~x0!ÄÊÍUWÞ|sÍO?>àM­îœÉh·ÛS,_ÃôõéD"’¾>hiñÒÚê¡¡!—ÖÖ\6l¨b÷îBvîœF(´€X¬”ÁÁùHéÇ4š}LŒä10[c@Ÿ„Öt…áƒnèè‡-;`g;4¶Bh=„?€È¡DA„ØOð…q'–¦‰êK.)½é gkZ’LVR¥ÛU†a08¨šChwïVسGcÆ�mm~fÓÕUÌž=séë«`` ”ÞÞZ ÃÙáe K½Œ�æ,Ö¦á¼3 »£°i�:°s=´4ÁÎm0Ø Ñ.èn}�“uɹDÿ’oËwÒIùO<ùäœåäè c=BúÈ…8mm1Ö¬‰³}{œuë<lݺ”öörêë—V—ÎEÊRNBm^׎Í@#fPŒ Øø*t¶Àë ÞF „·‚ÞEJ¤%ÏX1ž5•sØaŸ>úèì˘ÒÙ§±QÐÓcÐÔäfÍš Z[¬[WNWWº¾èB×g‘":ί”D“@M!h Có�¬k„æNx¯ ú7˜6±ôí˜Ä‘Œ!õ¿:Æ©UEÕŠ¿´xñ⛪«*r·o¯ §§œ¾¾"‘<Ë‘2Sú싧91µO0hÀÖ^h„¦~èl…Ž6ØÒ�=;¡ ¶™=˜¬ëãCÒâú0`|ˆ%ò—ã½ó ŒÓ¦õ`Æ š£Y’²ÏÂÞÒ͆kuhù�:¡á=èÞ ‘mÞƒ{0EV“ySäÙb‰¹äýæ ”ÏÕRvú˜aÊ$,a{:tÓ×ÓÜ «7Á{Û ½ xsÚÒ:¦Ôդ¾é$á›ÿ‚{ñ®€˜f )•DîH6×Ã@·„–AèÃæ.èê‡mÐÜ»ap3ÄÚ ÿ00›jLÍ“û@,%_øÏø.…·®ºfú“› H#á¶10íŸQØ3÷[û`÷zèj…† 0ØÑnèn�}è%¥¾¦ð!ÄX‰%ÿqßV‹t¾. …4tP$(¹NB“DlŒ ×½ ƒ°f D¶�{@o‚XéÞÑ)|Ä0b© ÎS<óΑl”á;‰·÷{'FW2ºâ;!Öˆ)q$f«ëÃÕ'1…}ÂXŒw°R(9aiôµbª­ds}JúLa S˜8üÊR¡L›O‹s���%tEXtdate:create�2013-04-23T16:33:29+02:00e²Ô���%tEXtdate:modify�2013-04-23T16:33:29+02:00K h����IEND®B`‚���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/packages.tex����������������������������������������������������������������������0000644�0001750�0001750�00000001571�13021324543�014370� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% replaced by usepackage{ifpdf} %\newif\ifpdf %\ifx\pdfoutput\undefined % \pdffalse % we are not running PDFLaTeX %\else % \ifnum\pdfoutput=0 % \pdffalse % we are not running PDFLaTeX % \else % \pdfoutput=1 \pdftrue % we are running PDFLaTeX % \fi %\fi \documentclass[twoside]{article} \usepackage{hevea} \usepackage{a4} \usepackage{calc} \usepackage{multicol} \usepackage{tabularx} \usepackage{makeidx} %\usepackage{xifthen} \usepackage{fancyhdr} \usepackage{supertabular} %\usepackage{longtable} \usepackage{ifpdf} %HEVEA \pdffalse \ifpdf \usepackage[pdftex]{graphicx} \usepackage[pdftex=true]{hyperref} \hypersetup{% pdftitle = {GNU-Prolog Manual}, pdfsubject = {GNU-Prolog Manual}, pdfkeywords = {GNU-Prolog, Prolog, Finite Domain Constraints}, pdfauthor = {Daniel Diaz} } \else \usepackage[dvips]{graphicx} % \usepackage{epsfig} \fi ���������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/debug-box.eps���������������������������������������������������������������������0000644�0001750�0001750�00000011036�13021324543�014452� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%!PS-Adobe-2.0 EPSF-2.0 %%Title: fig2.eps %%Creator: fig2dev Version 3.2 Patchlevel 1 %%CreationDate: Fri Feb 19 13:34:02 1999 %%For: aude@borba.inria.fr (Jean-Christophe Aude) %%Orientation: Portrait %%BoundingBox: 0 0 283 88 %%Pages: 0 %%BeginSetup %%EndSetup %%Magnification: 1.0000 %%EndComments /$F2psDict 200 dict def $F2psDict begin $F2psDict /mtrx matrix put /col-1 {0 setgray} bind def /col0 {0.000 0.000 0.000 srgb} bind def /col1 {0.000 0.000 1.000 srgb} bind def /col2 {0.000 1.000 0.000 srgb} bind def /col3 {0.000 1.000 1.000 srgb} bind def /col4 {1.000 0.000 0.000 srgb} bind def /col5 {1.000 0.000 1.000 srgb} bind def /col6 {1.000 1.000 0.000 srgb} bind def /col7 {1.000 1.000 1.000 srgb} bind def /col8 {0.000 0.000 0.560 srgb} bind def /col9 {0.000 0.000 0.690 srgb} bind def /col10 {0.000 0.000 0.820 srgb} bind def /col11 {0.530 0.810 1.000 srgb} bind def /col12 {0.000 0.560 0.000 srgb} bind def /col13 {0.000 0.690 0.000 srgb} bind def /col14 {0.000 0.820 0.000 srgb} bind def /col15 {0.000 0.560 0.560 srgb} bind def /col16 {0.000 0.690 0.690 srgb} bind def /col17 {0.000 0.820 0.820 srgb} bind def /col18 {0.560 0.000 0.000 srgb} bind def /col19 {0.690 0.000 0.000 srgb} bind def /col20 {0.820 0.000 0.000 srgb} bind def /col21 {0.560 0.000 0.560 srgb} bind def /col22 {0.690 0.000 0.690 srgb} bind def /col23 {0.820 0.000 0.820 srgb} bind def /col24 {0.500 0.190 0.000 srgb} bind def /col25 {0.630 0.250 0.000 srgb} bind def /col26 {0.750 0.380 0.000 srgb} bind def /col27 {1.000 0.500 0.500 srgb} bind def /col28 {1.000 0.630 0.630 srgb} bind def /col29 {1.000 0.750 0.750 srgb} bind def /col30 {1.000 0.880 0.880 srgb} bind def /col31 {1.000 0.840 0.000 srgb} bind def end save -152.0 249.0 translate 1 -1 scale /cp {closepath} bind def /ef {eofill} bind def /gr {grestore} bind def /gs {gsave} bind def /sa {save} bind def /rs {restore} bind def /l {lineto} bind def /m {moveto} bind def /rm {rmoveto} bind def /n {newpath} bind def /s {stroke} bind def /sh {show} bind def /slc {setlinecap} bind def /slj {setlinejoin} bind def /slw {setlinewidth} bind def /srgb {setrgbcolor} bind def /rot {rotate} bind def /sc {scale} bind def /sd {setdash} bind def /ff {findfont} bind def /sf {setfont} bind def /scf {scalefont} bind def /sw {stringwidth} bind def /tr {translate} bind def /tnt {dup dup currentrgbcolor 4 -2 roll dup 1 exch sub 3 -1 roll mul add 4 -2 roll dup 1 exch sub 3 -1 roll mul add 4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} bind def /shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul 4 -2 roll mul srgb} bind def /$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def /$F2psEnd {$F2psEnteredState restore end} def %%EndProlog $F2psBegin 10 setmiterlimit n -1000 5149 m -1000 -1000 l 8238 -1000 l 8238 5149 l cp clip 0.06000 0.06000 sc % Polyline 7.500 slw n 4200 2700 m 6000 2700 l 6000 3600 l 4200 3600 l cp gs col0 s gr /Times-Roman ff 180.00 scf sf 4747 3195 m gs 1 -1 sc (predicate) col0 sh gr % Polyline gs clippath 4080 2820 m 4200 2850 l 4080 2880 l 4215 2880 l 4215 2820 l cp clip n 3375 2850 m 4200 2850 l gs col0 s gr gr % arrowhead n 4080 2820 m 4200 2850 l 4080 2880 l 4080 2850 l 4080 2820 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 6705 2820 m 6825 2850 l 6705 2880 l 6840 2880 l 6840 2820 l cp clip n 6000 2850 m 6825 2850 l gs col0 s gr gr % arrowhead n 6705 2820 m 6825 2850 l 6705 2880 l 6705 2850 l 6705 2820 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3495 3480 m 3375 3450 l 3495 3420 l 3360 3420 l 3360 3480 l cp clip n 4200 3450 m 3375 3450 l gs col0 s gr gr % arrowhead n 3495 3480 m 3375 3450 l 3495 3420 l 3495 3450 l 3495 3480 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 3495 4080 m 3375 4050 l 3495 4020 l 3360 4020 l 3360 4080 l cp clip n 5100 3600 m 5100 4050 l 3375 4050 l gs col0 s gr gr % arrowhead n 3495 4080 m 3375 4050 l 3495 4020 l 3495 4050 l 3495 4080 l cp gs 0.00 setgray ef gr col0 s % Polyline gs clippath 6120 3480 m 6000 3450 l 6120 3420 l 5985 3420 l 5985 3480 l cp clip n 6825 3450 m 6000 3450 l gs col0 s gr gr % arrowhead n 6120 3480 m 6000 3450 l 6120 3420 l 6120 3450 l 6120 3480 l cp gs 0.00 setgray ef gr col0 s /Times-Roman ff 180.00 scf sf 6900 3495 m gs 1 -1 sc (redo) col0 sh gr /Times-Roman ff 180.00 scf sf 6900 2895 m gs 1 -1 sc (exit) col0 sh gr /Times-Roman ff 180.00 scf sf 3300 2910 m gs 1 -1 sc (call) dup sw pop neg 0 rm col0 sh gr /Times-Roman ff 180.00 scf sf 3300 3495 m gs 1 -1 sc (fail) dup sw pop neg 0 rm col0 sh gr /Times-Roman ff 180.00 scf sf 3300 4095 m gs 1 -1 sc (exception) dup sw pop neg 0 rm col0 sh gr $F2psEnd rs ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/macros.tex������������������������������������������������������������������������0000644�0001750�0001750�00000025137�13021324543�014102� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% general page/margin sizes \setlength{\oddsidemargin}{-.25cm} \setlength{\evensidemargin}{-.25cm} \setlength{\topmargin}{-50pt} \setlength{\headheight}{1.5cm} \setlength{\textwidth}{16cm} \setlength{\textheight}{23cm} % spacing lengths (note that we should define our own itemize environment % customizing the sizes with the second argument {decls} % cf. p112 of the LaTeX book or p59-62 of the Companion book \setlength{\parindent}{0cm} \setlength{\parskip}{\baselineskip} \setlength{\partopsep}{-\baselineskip} \setlength{\topsep}{0pt} % save parskip for destroy+restore (cf. cover, tbl-contents) \newlength{\saveparskip} \setlength{\saveparskip}{\parskip} % To avoid underfull vbox errors due to [twosides] \raggedbottom % Fancy headings \pagestyle{fancy} %\setlength{\headrulewidth}{0.8pt} \renewcommand{\headrulewidth}{0.8pt} \lhead[\thepage]{\rightmark} \chead{} \rhead[\leftmark]{\thepage} \lfoot{} \cfoot{} \rfoot{} % New space for subsubsection numbers in the table of contents %BEGIN LATEX \makeatletter \renewcommand{\l@subsubsection}{\@dottedtocline{3}{3.8em}{3.6em}} \makeatother %END LATEX % Vertical space commands \newcommand{\BL}{\vspace{\baselineskip}} \newcommand{\SkipUp}{\vspace{-\multicolsep}} % Some characters in tt font \def\bs{\char'134} \def\lt{\char'074} \def\gt{\char'076} \def\lb{\char'173} \def\rb{\char'175} \def\us{\char'137} % Style of a parameter \def\Param#1{\texttt{\textit{#1}}} % A reference to a section/page \newcommand{\RefSP}[1]{(section~\ref{#1}, page~\pageref{#1})} % Url in LaTeX output \ifpdf \newcommand{\Tilde}[1]{~#1} \newcommand{\MyUrl}[2]{\href{#1}{#2}} \newcommand{\MyUrlHtml}[2]{\href{#1}{#2}} \else \newcommand{\Tilde}[1]{\~{}#1} \newcommand{\MyUrl}[2]{\footahref{#1}{#2}} \newcommand{\MyUrlHtml}[2]{#2} \fi \newcommand{\MyEMail}[2]{#2\footnote{\texttt{#1}}} % General environments \newenvironment{CmdOptions}% {\begin{tabular}{p{4.5cm}l}}% {\end{tabular}} \newenvironment{ItemizeThreeCols}% {\begin{multicols}{3}\raggedcolumns\begin{itemize}}% {\end{itemize}\end{multicols}\SkipUp} \newenvironment{Indentation}% {\begin{list}{}{}% \item }% {\end{list}} \newenvironment{Code}% {\begin{Indentation}\begin{tt}}% {\end{tt}\end{Indentation}} \newenvironment{CodeTwoCols}[1][4cm]% {\begin{Indentation}\begin{tabular}{@{}p{#1}@{}l@{}}}% {\end{tabular}\end{Indentation}} \def\One#1{\multicolumn{2}{@{}l}{\texttt{#1}} \\} \def\Two#1#2{\texttt{#1} & #2\\} \def\SkipLine{\multicolumn{2}{@{}l}{} \\} \def\OneLine#1{\begin{Code}#1\end{Code}} \newcommand{\OneLineTwoCols}[3][4cm]% {\begin{CodeTwoCols}[#1]\Two{#2}{#3}\end{CodeTwoCols}} % fix for HeVeA info mode (\\ on a single line causes HeVeA to loop) % %\renewcommand{\OneLineTwoCols}[3][4cm]% % {\begin{CodeTwoCols}[#1]\texttt{#2} & {#3}\end{CodeTwoCols}} \newlength{\tmplg} \newcounter{colnbround} \newenvironment{TabularC}[1]% {\setcounter{colnbround}{#1} \addtocounter{colnbround}{1} \setlength{\tmplg}{\linewidth/#1 - \tabcolsep*2 % - \arrayrulewidth*\value{colnbround}/#1}% \par\begin{tabular*}{\linewidth}% {|*{#1}{>{\raggedright\arraybackslash\hspace{0pt}}% m{\the\tmplg}|}}}% {\end{tabular*}\par} % For use in tabular (parameter is column width) \newcolumntype{C}[1]{>{\centering\arraybackslash}m{#1}} \newcolumntype{L}[1]{>{\raggedright\arraybackslash}m{#1}} \newcolumntype{R}[1]{>{\raggedleft\arraybackslash}m{#1}} % Image inclusion \newcommand{\InsertImage}[2][scale=0.83]% {\BL\begin{center}\includegraphics[#1]{#2}\end{center}\BL} % Bips description \def\SPart#1{\textbf{#1}} \def\Templates{\SPart{Templates}} \def\Description{\SPart{Description}} \def\Errors{\SPart{Errors}} \def\Portability{\SPart{Portability}} \newenvironment{TemplatesOneCol}% {\Templates\par\begin{Code}}% {\end{Code}} \newenvironment{TemplatesTwoCols}% {\Templates\par\begin{multicols}{2}\raggedcolumns\begin{Code}}% {\end{Code}\end{multicols}\SkipUp} \def\PlErrorsNone{\Errors\par None.} \newenvironment{PlErrorsNoTitle}% {\par\begin{TabularC}{2}\hline}% {\end{TabularC}} \newenvironment{PlErrors}% {\Errors\begin{PlErrorsNoTitle}}% {\end{PlErrorsNoTitle}} \def\ErrCond#1{#1 &} \def\ErrTerm#1{\texttt{#1} \\ \hline} \def\ErrTermRm#1{#1 \\ \hline} % Index % new environnement to use \pagestyle{fancy} and \section{} % copied from article.cls with the following changes: % remove \thispagestyle{plain} % add \addcontentsline{toc}{section}{\numberline{}\indexname}} %BEGIN LATEX \makeatletter \renewenvironment{theindex} {\if@twocolumn \@restonecolfalse \else \@restonecoltrue \fi \columnseprule \z@ \columnsep 35\p@ \twocolumn[\section*{\indexname}]% \@mkboth{\MakeUppercase\indexname}% {\MakeUppercase\indexname}% \parindent\z@ \parskip\z@ \@plus .3\p@\relax \addcontentsline{toc}{section}{\numberline{}\indexname} \let\item\@idxitem} {\if@restonecol\onecolumn\else\clearpage\fi} \makeatother %END LATEX \ifpdf \def\OneUrl#1{\href{#1}{#1}} \else \def\OneUrl#1{\ahrefurl{#1}} \fi % Define a section without no and include it in the TOC % 1= a label (name) for HeVeA (useless for LaTeX) % 2= The text of the section % See also redef for HeVeA in custom.hva \newcommand{\SectionWithoutNo}[2] {\section*{#2}% \addcontentsline{toc}{section}{\numberline{}#2}} % Index management: % in the following, suffix T/TD/D/void means: % T: texttt, D: definition, TD: both, void: simple % |textbf for \index does not work with hyperref (pdflatex)... % We need to pass by the below 'IndexBold' command. \ifpdf \newcommand{\IndexBold}[1]{\textbf{\hyperpage{#1}}} \else \newcommand{\IndexBold}[1]{\textbf{#1}} \fi % Add an index entry % 1=alphabetic position 2=complete index term \newcommand{\IndT} [2]{\index{#1@\texttt{#2}}} \newcommand{\IndTD}[2]{\index{#1@\texttt{#2}|IndexBold}} \newcommand{\IndD} [2]{\index{#1@#2|IndexBold}} \newcommand{\Ind} [2]{\index{#1@#2}} % Add text and an index entry % 1=text term 2=alphabetic position 3=complete index term % NB: define the \index before the text to have correct HTML anchors \newcommand{\TxtIndT} [3]{\IndT{#2}{#3}\texttt{#1}} \newcommand{\TxtIndTD}[3]{\IndTD{#2}{#3}\texttt{#1}} \newcommand{\TxtIndD} [3]{\IndD{#2}{#3}#1} \newcommand{\TxtInd} [3]{\Ind{#2}{#3}#1} % Add... macros insert something in the index ONLY % Idx... macros insert something in the index AND in the text % Any word (roman font) \newcommand{\AddD} [1]{\IndD {#1}{#1}} \newcommand{\Add} [1]{\Ind {#1}{#1}} \newcommand{\IdxD} [1]{\TxtIndD {#1}{#1}{#1}} \newcommand{\Idx} [1]{\TxtInd {#1}{#1}{#1}} % Keyword (tt font) \newcommand{\AddKD} [1]{\IndTD {#1}{#1}} \newcommand{\AddK} [1]{\IndT {#1}{#1}} \newcommand{\IdxKD} [1]{\TxtIndTD{#1}{#1}{#1}} \newcommand{\IdxK} [1]{\TxtIndT {#1}{#1}{#1}} % Directive \newcommand{\AddDiD}[1]{\IndTD {#1}{#1 \textrm{(directive)}}} \newcommand{\AddDi} [1]{\IndT {#1}{#1 \textrm{(directive)}}} \newcommand{\IdxDiD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(directive)}}} \newcommand{\IdxDi} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(directive)}}} % Control Construct \newcommand{\AddCCD}[1]{\IndTD {#1}{#1}} \newcommand{\AddCC} [1]{\IndT {#1}{#1}} \newcommand{\IdxCCD}[1]{\TxtIndTD{#1}{#1}{#1}} \newcommand{\IdxCC} [1]{\TxtIndT {#1}{#1}{#1}} % Prolog Keyword \newcommand{\AddPKD}[1]{\IndTD {#1}{#1}} \newcommand{\AddPK} [1]{\IndT {#1}{#1}} \newcommand{\IdxPKD}[1]{\TxtIndTD{#1}{#1}{#1}} \newcommand{\IdxPK} [1]{\TxtIndT {#1}{#1}{#1}} % Prolog Built-in \newcommand{\AddPBD}[1]{\IndTD {#1}{#1}} \newcommand{\AddPB} [1]{\IndT {#1}{#1}} \newcommand{\IdxPBD}[1]{\TxtIndTD{#1}{#1}{#1}} \newcommand{\IdxPB} [1]{\TxtIndT {#1}{#1}{#1}} % Prolog Property \newcommand{\AddPPD}[1]{\IndTD {#1}{#1 \textrm{(property)}}} \newcommand{\AddPP} [1]{\IndT {#1}{#1 \textrm{(property)}}} \newcommand{\IdxPPD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(property)}}} \newcommand{\IdxPP} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(property)}}} % Prolog Global Variable \newcommand{\AddPGD}[1]{\IndTD {#1}{#1 \textrm{(global var.)}}} \newcommand{\IdxPGD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(global var.)}}} % Prolog Option \newcommand{\AddPOD}[1]{\IndTD {#1}{#1 \textrm{(option)}}} \newcommand{\AddPO} [1]{\IndT {#1}{#1 \textrm{(option)}}} \newcommand{\IdxPOD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(option)}}} \newcommand{\IdxPO} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(option)}}} % Prolog Mode \newcommand{\AddPMD}[1]{\IndTD {#1}{#1 \textrm{(mode)}}} \newcommand{\IdxPMD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(mode)}}} % Prolog Whence \newcommand{\AddPWD}[1]{\IndTD {#1}{#1 \textrm{(whence)}}} \newcommand{\IdxPWD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(whence)}}} % Prolog File Permission \newcommand{\AddPXD}[1]{\IndTD {#1}{#1 \textrm{(permission)}}} \newcommand{\IdxPXD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(permission)}}} % Prolog Token \newcommand{\AddPTD}[1]{\IndTD {#1}{#1 \textrm{(token)}}} \newcommand{\IdxPTD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(token)}}} % Prolog Flag \newcommand{\AddPFD}[1]{\IndTD {#1}{#1 \textrm{(flag)}}} \newcommand{\AddPF} [1]{\IndT {#1}{#1 \textrm{(flag)}}} \newcommand{\IdxPFD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(flag)}}} \newcommand{\IdxPF} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(flag)}}} % Debugger Keyword \newcommand{\AddDKD}[1]{\IndTD {#1}{#1 \textrm{(debug)}}} \newcommand{\AddDK} [1]{\IndT {#1}{#1 \textrm{(debug)}}} \newcommand{\IdxDKD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(debug)}}} \newcommand{\IdxDK} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(debug)}}} % Debugger Built-in \newcommand{\AddDBD}[1]{\IndTD {#1}{#1 \textrm{(debug)}}} \newcommand{\AddDB} [1]{\IndT {#1}{#1 \textrm{(debug)}}} \newcommand{\IdxDBD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(debug)}}} \newcommand{\IdxDB} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(debug)}}} % FD Built-in \newcommand{\AddFBD}[1]{\IndTD {#1}{#1 \textrm{(FD)}}} \newcommand{\AddFB} [1]{\IndT {#1}{#1 \textrm{(FD)}}} \newcommand{\IdxFBD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(FD)}}} \newcommand{\IdxFB} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(FD)}}} % FD Option \newcommand{\AddFOD}[1]{\IndTD {#1}{#1 \textrm{(FD option)}}} \newcommand{\IdxFOD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(FD option)}}} % FD Keyword \newcommand{\AddFKD}[1]{\IndTD {#1}{#1 \textrm{(FD)}}} \newcommand{\AddFK} [1]{\IndT {#1}{#1 \textrm{(FD)}}} \newcommand{\IdxFKD}[1]{\TxtIndTD{#1}{#1}{#1 \textrm{(FD)}}} \newcommand{\IdxFK} [1]{\TxtIndT {#1}{#1}{#1 \textrm{(FD)}}} ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/c-interface.tex�������������������������������������������������������������������0000644�0001750�0001750�00000214215�13021324543�014773� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{Interfacing Prolog and C} \label{Interfacing-Prolog-and-C} %HEVEA\cutdef[1]{subsection} \subsection{Introduction} The foreign code interface allows the use to link Prolog and C in both directions. A Prolog predicate can call a C function passing different kinds of arguments (input, output or input/output). The interface performs implicit Prolog $\leftrightarrow$ C data conversions for simple types (for instance a Prolog integer is automatically converted into a C integer) and provides a set of API (Application Programming Interface) functions to convert more complex types (lists or structures). The interface also performs automatic error detection depending on the actual type of the passed argument. An important feature is the ability to write non-deterministic code in C. It is also possible to call (or callback) a Prolog predicate from a C function and to manage Prolog non-determinism: the C code can ask for next solutions, remove all remaining solutions or terminate and keep alternatives for the calling Prolog predicate). \subsection{Including and using \texttt{gprolog.h}} The C code should include \texttt{gprolog.h} which provides a set of C definitions (types, macros, prototypes) associated to the API. Include this files as follows: \begin{Indentation} \begin{verbatim} #include <gprolog.h> \end{verbatim} \end{Indentation} If the installation has been correctly done nothing else is needed. If the C compiler/preprocessor cannot locate \texttt{gprolog.h} pass the C compiler option required to specify an additional include directory (e.g.\texttt{-I}\texttt{include\_dir}) to \texttt{gplc} as follows \RefSP{Using-the-compiler}: \OneLine{\% gplc -C -I\textrm{include\_dir ...}} The file \texttt{gprolog.h} declares the following C types: \begin{itemize} \item \texttt{PlBool} as an integer and the constants \texttt{PL\_FALSE} (i.e. 0) and \texttt{PL\_TRUE} (i.e. 1). \item \texttt{PlLong} as an integer able to store a pointer (equivalent to \texttt{intptr\_t}). This type appeared in GNU Prolog 1.4.0 in replacement of \texttt{long} to support Windows 64 bits (where the \texttt{long} type is only 32 bits). This type is used to handle integer types. \item \texttt{PlULong} same as \texttt{PlLong} but unsigned (same as \texttt{uintptr\_t}). \item \texttt{PlTerm} same as \texttt{intptr\_t}. This type is used to store general Prolog terms. \end{itemize} \textbf{New in GNU Prolog 1.3.1 and backward compatibility issues}: in GNU Prolog 1.3.1 the API has been modified to protect namespace. The name of public functions, macros, variables and types are now prefixed with \texttt{Pl\_}, \texttt{PL\_} or \texttt{pl\_}. All these prefixes should be avoided by the foreign C-code to prevent name clashes. To ensure a backward compatibility, the names used by the old API are available thanks to a set of \texttt{\#define}. However, this deprecated API should not be used by recent code. It is also possible to prevent the definition of the compatibility macros using: \begin{Indentation} \begin{verbatim} #define __GPROLOG_FOREIGN_STRICT__ #include <gprolog.h> \end{verbatim} \end{Indentation} In addition, \texttt{gprolog.h} defines a set of macros: \begin{itemize} \item \texttt{ \_\_GNU\_PROLOG\_\_} (as the major version). \item \texttt{ \_\_GPROLOG\_\_}, \texttt{\_\_GPROLOG\_MINOR\_\_} and \texttt{\_\_GPROLOG\_PATCHLEVEL\_\_}. Their values are the major version, minor version, and patch level of GNU Prolog, as integer constants. For example, GNU Prolog 1.3.2 will define \texttt{\_\_\_\_GPROLOG\_\_} to 1, \texttt{\_\_\_\_GPROLOG\_MINOR\_\_} to 3, and \texttt{\_\_\_\_GPROLOG\_PATCHLEVEL\_\_} to 2. If you need to write code which depends on a specific version, you must be more careful. Recall these macros appeared in GNU Prolog 1.3.1 (undefined before), each time the minor version is increased, the patch level is reset to zero; each time the major version is increased (which happens rarely), the minor version and patch level are reset. \item \texttt{\_\_GPROLOG\_VERSION\_\_}: the version as an integer defined as follows: $major * 10000 + minor * 100 + patch level$. For example: version 1.3.2 will result in the value 10302. \item \texttt{PL\_PROLOG\_DIALECT}: a C constant string (generally \texttt{"gprolog"}). Appeared in 1.3.2. \item \texttt{PL\_PROLOG\_NAME}: a C constant string (generally \texttt{"GNU Prolog"}). \item \texttt{PL\_PROLOG\_VERSION}: a C constant string associated to the version (e.g. \texttt{"1.4.0"}). \item \texttt{PL\_PROLOG\_DATE}: a C constant string associated with the date of this version (e.g. \texttt{"Mar 29 2011"}. \item \texttt{PL\_PROLOG\_COPYRIGHT}: a C constant string associated with the copyright of this version (e.g. \texttt{"Copyright (C) 1999-2015 Daniel Diaz"}. \end{itemize} Note the above \texttt{PL\_PROLOG\_}... macros are also accessible via Prolog flags thanks to the built-in predicate \texttt{current\_prolog\_flag/2} \RefSP{current-prolog-flag/2} \subsection{Calling C from Prolog} \label{Calling-C-from-Prolog} \subsubsection{Introduction} This interface can then be used to write both simple and complex C routines. A simple routine uses either input or output arguments which type is simple. In that case the user does not need any knowledge of Prolog data structures since all Prolog $\leftrightarrow$ C data conversions are implicitly achieved. To manipulate complex terms (lists, structures) a set of functions is provided. Finally it is also possible to write non-deterministic C code. \subsubsection{\AddDiD{foreign/1}% \IdxDiD{foreign/2} directive \label{foreign/2-directive}} \texttt{foreign/2} directive \RefSP{foreign/2} declares a C function interface. The general form is \texttt{foreign(Template, Options)} which defines an interface predicate whose prototype is \texttt{Template} according to the options given by \texttt{Options}. \texttt{Template} is a callable term specifying the type/mode of each argument of the associated Prolog predicate. \SPart{Foreign options}: \texttt{Options} is a list of foreign options. If this list contains contradictory options, the rightmost option is the one which applies. Possible options are: \begin{itemize} \item \AddPOD{fct\_name}\texttt{fct\_name(F)}: \texttt{F} is an atom representing the name of the C function to call. By default the name of the C function is the same as the principal functor of \texttt{Template}. In any case, the atom associated with the name of the function must conforms to the syntax of C identifiers. \item \AddPOD{return}\texttt{return(boolean}/\texttt{none}/\texttt{jump)}: specifies the value returned by the C function: \begin{itemize} \item \IdxPOD{boolean}: the type of the function is \texttt{PlBool} (returns \texttt{PL\_TRUE} on success, \texttt{PL\_FALSE} otherwise). \item \IdxPOD{none}: the type of the function is \texttt{void} (no returned value). \item \IdxPOD{jump}: the type of the function is \texttt{void(*)()} (returns the address of a Prolog code to execute). \end{itemize} The default value is \texttt{boolean}. \item \AddPOD{bip\_name}\texttt{bip\_name(Name, Arity)}: initializes the error context with \texttt{Name} and \texttt{Arity}. If an error occurs this information is used to indicate from which predicate the error occurred \RefSP{General-format-and-error-context}. It is also possible to prevent the initialization of the error context using \texttt{bip\_name(none)}. By default \texttt{Name} and \texttt{Arity} are set to the functor and arity of \texttt{Template}. \item \AddPOD{choice\_size}\texttt{choice\_size(N)}: this option specifies that the function implements a non-deterministic code. \texttt{N} is an integer specifying the size needed by the non-deterministic C function. This facility is explained later \RefSP{Writing-non-deterministic-C-code}. By default a foreign function is deterministic. \end{itemize} \texttt{foreign(Template)} is equivalent to \texttt{foreign(Template, [])}. \SPart{Foreign modes and types}: each argument of \texttt{Template} specifies the foreign mode and type of the corresponding argument. This information is used to check the type of effective arguments at run-time and to perform Prolog $\leftrightarrow$ C data conversions. Each argument of \texttt{Template} is formed with a mode symbol followed by a type name. Possible foreign modes are: \begin{itemize} \item \texttt{+}: input argument. \item \texttt{-}: output argument. \item \texttt{?}: input/output argument. \end{itemize} Possible foreign types are: \begin{tabular}{|l|l|l|l|} \hline Foreign type & Prolog type & C type & Description of the C type \\ \hline\hline \texttt{integer} & integer & \texttt{PlLong} & value of the integer \\ \hline \texttt{positive} & positive integer & \texttt{PlLong} & value of the integer \\ \hline \texttt{float} & floating point number & \texttt{double} & value of the floating point number \\ \hline \texttt{number} & number & \texttt{double} & value of the number \\ \hline \texttt{atom} & atom & \texttt{PlLong} & internal key of the atom \\ \hline \texttt{boolean} & boolean & \texttt{PlLong} & value of the boolean (0=\texttt{false}, 1=\texttt{true}) \\ \hline \texttt{char} & character & \texttt{PlLong} & value of (the code of) the character \\ \hline \texttt{code} & character code & \texttt{PlLong} & value of the character-code \\ \hline \texttt{byte} & byte & \texttt{PlLong} & value of the byte \\ \hline \texttt{in\_char} & in-character & \texttt{PlLong} & value of the character or \texttt{-1} for end-of-file \\ \hline \texttt{in\_code} & in-character code & \texttt{PlLong} & value of the character-code or \texttt{-1} for end-of-file \\ \hline \texttt{in\_byte} & in-byte & \texttt{PlLong} & value of the byte or \texttt{-1} for the end-of-file \\ \hline \texttt{string} & atom & \texttt{char *} & C string containing the name of the atom \\ \hline \texttt{chars} & character list & \texttt{char *} & C string containing the characters of the list \\ \hline \texttt{codes} & character-code list & \texttt{char *} & C string containing the characters of the list \\ \hline \texttt{term} & Prolog term & \texttt{PlTerm} & generic Prolog term \\ \hline \end{tabular} \SPart{Simple foreign type}: a simple type is any foreign type listed in the above tabled except \texttt{term}. A simple foreign type is an atomic term (character and character-code lists are in fact lists of constants). Each simple foreign type is converted to/from a C type to simplify the writing of the C function. \SPart{Complex foreign type}: type foreign type \texttt{term} refers to any Prolog term (e.g. lists, structures\ldots). When such an type is specified the argument is passed to the C function as a \texttt{PlTerm} (GNU Prolog C type equivalent to a \texttt{PlLong}). Several functions are provided to manipulate \texttt{PlTerm} variables \RefSP{Manipulating-Prolog-terms}. Since the original term is passed to the function it is possible to read its value or to unify it. So the meaning of the mode symbol is less significant. For this reason it is possible to omit the mode symbol. In that case \texttt{term} is equivalent to \texttt{+term}. \subsubsection{The C function} The type returned by the C function depends on the value of the \IdxPO{return} foreign option \RefSP{foreign/2-directive}. If it is \IdxPO{boolean} then the C function is of type \texttt{PlBool} and shall return \texttt{PL\_TRUE} in case of success and \texttt{PL\_FALSE} otherwise. If the \texttt{return} option is \IdxPO{none} the C function is of type \texttt{void}. Finally if it is \IdxPO{jump}, the function shall return the address of a Prolog predicate and, at the exit of the function, the control is given to that predicate. The type of the arguments of the C function depends on the mode and type declaration specified in \texttt{Template} for the corresponding argument as explained in the following sections. \subsubsection{Input arguments} \label{Input-arguments} An input argument is tested at run-time to check if its type conforms to the foreign type and then it is passed to the C function. The type of the associated C argument is given by the above table \RefSP{foreign/2-directive}. For instance, the effective argument \texttt{Arg} associated with \texttt{+positive} foreign declaration is submitted to the following process: \begin{itemize} \item if \texttt{Arg} is a variable an \texttt{instantiation\_error} is raised. \item if \texttt{Arg} is neither a variable nor an integer a \texttt{type\_error(integer, Arg)} is raised. \item if \texttt{Arg} is an integer $<$ 0 a \texttt{domain\_error(not\_less\_than\_zero, Arg)} is raised. \item otherwise the value of \texttt{Arg} is passed to the C is passed to the C function as an integer (\texttt{PlLong}). \end{itemize} When \texttt{+string} is specified the string passed to the function is the internal string of the corresponding atom and should not be modified. When \texttt{+term} is specified the term passed to the function is the original Prolog term. It can be read and/or unified. It is also the case when \texttt{term} is specified without any mode symbol. \subsubsection{Output arguments} \label{Output-arguments} An output argument is tested at run-time to check if its type conforms to the foreign type and it is unified with the value set by the C function. The type of the associated C argument is a pointer to the type given by the above table \RefSP{foreign/2-directive}. For instance, the effective argument \texttt{Arg} associated with \texttt{-positive} foreign declaration is handled as follows: \begin{itemize} \item if \texttt{Arg} is neither a variable nor an integer a \texttt{type\_error(integer, Arg)} is raised. \item if \texttt{Arg} is an integer $<$ 0 a \texttt{domain\_error(not\_less\_than\_zero, Arg)} is raised. \item otherwise a pointer to an integer (\texttt{PlLong} \texttt{*}) is passed to the C function. If the function returns \texttt{PL\_TRUE} the integer stored at this location is unified with \texttt{Arg}. \end{itemize} When \texttt{-term} is specified, the function must construct a term into the its corresponding argument (which is of type \texttt{PlTerm *}). At the exit of the function this term will be unified with the actual predicate argument. \subsubsection{Input/output arguments} \label{Input/output-arguments} Basically an input/output argument is treated as in input argument if it is not a variable, as an output argument otherwise. The type of the associated C argument is a pointer to a \texttt{PlFIOArg} (GNU Prolog C type) defined as follows: \begin{Indentation} \begin{verbatim} typedef struct { PlBool is_var; PlBool unify; union { PlLong l; char *s; double d; }value; }PlFIOArg; \end{verbatim} \end{Indentation} The field \texttt{is\_var} is set to \texttt{PL\_TRUE} if the argument is a variable and \texttt{PL\_FALSE} otherwise. This value can be tested by the C function to determine which treatment to perform. The field \texttt{unify} controls whether the effective argument must be unified at the exit of the C function. Initially \texttt{unify} is set to the same value as \texttt{is\_var} (i.e. a variable argument will be unified while a non-variable argument will not) but it can be modified by the C function. The field \texttt{value} stores the value of the argument. It is declared as a C \texttt{union} since there are several kinds of value types. The field \texttt{s} is used for C strings, \texttt{d} for C doubles and \texttt{l} otherwise (\texttt{int}, \texttt{PlLong}, \texttt{PlTerm}). if \texttt{is\_var} is \texttt{PL\_FALSE} then \texttt{value} contains the input value of the argument with the same conventions as for input arguments \RefSP{Input-arguments}. At the exit of the function, if unify is \texttt{PL\_TRUE} \texttt{value} must contain the value to unify with the same conventions as for output arguments \RefSP{Output-arguments}. For instance, the effective argument \texttt{Arg} associated with \texttt{?positive} foreign declaration is handled as follows: \begin{itemize} \item if \texttt{Arg} is a variable \texttt{is\_var} and \texttt{unify} are set to \texttt{PL\_TRUE} else to \texttt{PL\_FALSE} and its value is copied in \texttt{value.l}. \item if \texttt{Arg} is neither a variable nor an integer a \texttt{type\_error(integer, Arg)} is raised. \item if \texttt{Arg} is an integer $<$ 0 a \texttt{domain\_error(not\_less\_than\_zero, Arg)} is raised. \item otherwise a pointer to the \texttt{PlFIOArg} (\texttt{PlFIOArg} \texttt{*}) is passed to the C function. If the function returns \texttt{PL\_TRUE} and if \texttt{unify} is \texttt{PL\_TRUE} the value stored in \texttt{value.l} is unified with \texttt{Arg}. \end{itemize} \subsubsection{Writing non-deterministic C code} \label{Writing-non-deterministic-C-code} The interface allows the user to write non-deterministic C code. When a C function is non-deterministic, a choice-point is created for this function. When a failure occurs, if all more recent non-deterministic code are finished, the function is re-invoked. It is then important to inform Prolog when there is no more solution (i.e. no more choice) for a non-deterministic code. So, when no more choices remains the function must remove the choice-point. The interface increments a counter each time the function is re-invoked. At the first call this counter is equal to 0. This information allows the function to detect its first call. When writing non-deterministic code, it is often useful to record data between consecutive re-invocations of the function. The interface maintains a buffer to record such an information. The size of this buffer is given by \AddPO{choice\_size}\texttt{choice\_size(N)} when using \texttt{foreign/2} \RefSP{foreign/2-directive}. This size is the number of (consecutive) \texttt{PlLong}\emph{s} needed by the C function. Inside the function it is possible to call the following functions/macros: \begin{Indentation} \begin{verbatim} int Pl_Get_Choice_Counter(void) TYPE Pl_Get_Choice_Buffer (TYPE) void Pl_No_More_Choice (void) \end{verbatim} \end{Indentation} The macro \texttt{Pl\_Get\_Choice\_Counter()} returns the value of the invocation counter (0 at the first call). The macro \texttt{Pl\_Get\_Choice\_Buffer(\Param{TYPE})} returns a pointer to the buffer (casted to \Param{TYPE}). The function \texttt{Pl\_No\_More\_Choice()} deletes the choice point associated with the function. \subsubsection{Example: input and output arguments} All examples presented here can be found in the \texttt{ExamplesC} sub-directory of the distribution, in the files \texttt{examp.pl} (Prolog part) and \texttt{examp\_c.c} (C part). Let us define a predicate \texttt{first\_occurrence(A, C, P)} which unifies \texttt{P} with the position (from 0) of the first occurrence of the character \texttt{C} in the atom \texttt{A}. The predicate must fail if \texttt{C} does not appear in \texttt{A}. In the prolog file \texttt{examp.pl}: \OneLine{:- foreign(first\_occurrence(+string, +char, -positive)).} In the C file \texttt{examp\_c.c}: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool first_occurrence(char *str, PlLong c, PlLong *pos) { char *p; p = strchr(str, c); if (p == NULL) /* C does not appear in A */ return PL_FALSE; /* fail */ *pos = p - str; /* set the output argument */ return PL_TRUE; /* succeed */ } \end{verbatim} \end{Indentation} The compilation produces an executable called \texttt{examp}: \OneLine{\% gplc examp.pl examp\_c.c} Examples of use: \begin{Indentation} \begin{verbatim} | ?- first_occurrence(prolog, p, X). X = 0 | ?- first_occurrence(prolog, k, X). no | ?- first_occurrence(prolog, A, X). {exception: error(instantiation_error,first_occurrence/3)} | ?- first_occurrence(prolog, 1 ,X). {exception: error(type_error(character,1),first_occurrence/3)} \end{verbatim} \end{Indentation} \subsubsection{Example: non-deterministic code} We here define a predicate \texttt{occurrence(A, C, P)} which unifies \texttt{P} with the position (from 0) of one occurrence of the character \texttt{C} in the atom \texttt{A}. The predicate will fail if \texttt{C} does not appear in \texttt{A}. The predicate is re-executable on backtracking. The information that must be recorded between two invocations of the function is the next starting position in \texttt{A} to search for \texttt{C}. In the prolog file \texttt{examp.pl}: \OneLine{:- foreign(occurrence(+string, +char, -positive), [choice\_size(1)]).} In the C file \texttt{examp\_c.c}: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool occurrence(char *str, PlLong c, PlLong *pos) { char **info_pos; char *p; info_pos = Pl_Get_Choice_Buffer(char **); /* recover the buffer */ if (Pl_Get_Choice_Counter() == 0) /* first invocation ? */ *info_pos = str; p = strchr(*info_pos, c); if (p == NULL) /* c does not appear */ { Pl_No_More_Choice(); /* remove choice-point */ return PL_FALSE; /* fail */ } *pos = p - str; /* set the output argument */ *info_pos = p + 1; /* update next starting pos */ return PL_TRUE; /* succeed */ } \end{verbatim} \end{Indentation} The compilation produces an executable called \texttt{examp}: \OneLine{\% gplc examp.pl examp\_c.c} Examples of use: \begin{CodeTwoCols} \One{| ?- occurrence(prolog, o, X).} \SkipLine \Two{X = 2 ?}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = 4 ?}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{no} {(no more solution)} \SkipLine \One{| ?- occurrence(prolog, k, X).} \SkipLine \One{no} \end{CodeTwoCols} In the first example when the second (the last) occurrence is found (\texttt{X=4}) the choice-point remains and the failure is detected only when another solution is requested (by pressing \texttt{;}). It is possible to improve this behavior by deleting the choice-point when there is no more occurrence. To do this it is necessary to do one search ahead. The information stored is the position of the next occurrence. Let us define such a behavior for the predicate \texttt{occurrence2/3}. In the prolog file \texttt{examp.pl}: \OneLine{:- foreign(occurrence2(+string, +char, -positive), [choice\_size(1)]).} In the C file \texttt{examp\_c.c}: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool occurrence2(char *str, PlLong c, PlLong *pos) { char **info_pos; char *p; info_pos = Pl_Get_Choice_Buffer(char **); /* recover the buffer */ if (Pl_Get_Choice_Counter() == 0) /* first invocation ? */ { p = strchr(str, c); if (p == NULL) /* C does not appear at all */ { Pl_No_More_Choice(); /* remove choice-point */ return PL_FALSE; /* fail */ } *info_pos = p; } /* info_pos = an occurrence */ *pos = *info_pos - str; /* set the output argument */ p = strchr(*info_pos + 1, c); if (p == NULL) /* no more occurrence */ Pl_No_More_Choice(); /* remove choice-point */ else *info_pos = p; /* else update next solution */ return PL_TRUE; /* succeed */ } \end{verbatim} \end{Indentation} Examples of use: \begin{CodeTwoCols} \One{| ?- occurrence2(prolog, l, X).} \SkipLine \Two{X = 3}{(here the user is not prompted since there is no more alternative)} \SkipLine \One{| ?- occurrence2(prolog, o, X).} \SkipLine \Two{X = 2 ?}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = 4}{(here the user is not prompted since there is no more alternative)} \end{CodeTwoCols} \subsubsection{Example: input/output arguments} We here define a predicate \texttt{char\_ascii(Char, Code}) which converts in both directions the character \texttt{Char} and its character-code \texttt{Code}. This predicate is then similar to \IdxPB{char\_code/2} \RefSP{char-code/2}. In the prolog file \texttt{examp.pl}: \OneLine{:- foreign(char\_ascii(?char, ?code)).} In the C file \texttt{examp\_c.c}: \begin{Indentation} \begin{verbatim} #include <gprolog.h> PlBool char_ascii(PlFIOArg *c, PlFIOArg *ascii) { if (!c->is_var) /* Char is not a variable */ { ascii->unify = PL_TRUE; /* enforce unif. of Code */ ascii->value.l = c->value.l; /* set Code */ return PL_TRUE; /* succeed */ } if (ascii->is_var) /* Code is also a variable */ Pl_Err_Instantiation(); /* emit instantiation_error */ c->value.l = ascii->value.l; /* set Char */ return PL_TRUE; /* succeed */ } \end{verbatim} \end{Indentation} If \texttt{Char} is instantiated it is necessary to enforce the unification of \texttt{Code} since it could be instantiated. Recall that by default if an input/output argument is instantiated it will not be unified at the exit of the function \RefSP{Input/output-arguments}. If both \texttt{Char} and \texttt{Code} are variables the function raises an \texttt{instantiation\_error}. The way to raise Prolog errors is described later \RefSP{Raising-Prolog-errors}. The compilation produces an executable called \texttt{examp}: \OneLine{\% gplc examp.pl examp\_c.c} Examples of use: \begin{Indentation} \begin{verbatim} | ?- char_ascii(a, X). X = 97 | ?- char_ascii(X, 65). X = 'A' | ?- char_ascii(a, 12). no | ?- char_ascii(X, X). {exception: error(instantiation_error,char_ascii/2)} | ?- char_ascii(1, 12). {exception: error(type_error(character,1),char_ascii/2)} \end{verbatim} \end{Indentation} \subsection{Manipulating Prolog terms} \label{Manipulating-Prolog-terms} \subsubsection{Introduction} \label{Introduction:(Manipulating-Prolog-terms)} In the following we presents a set of functions to manipulate Prolog terms. For simple foreign terms the functions manipulate simple C types \RefSP{foreign/2-directive}. Functions managing lists handle an array of 2 elements (of type \texttt{PlTerm}) containing the terms corresponding to the head and the tail of the list. For the empty list \texttt{NULL} is passed as the array. These functions require to flatten a list in each sub-list. To simplify the management of proper lists (i.e. lists terminated by \texttt{[]}) a set of functions is provided that handle the number of elements of the list (an integer) and an array whose elements (of type \texttt{PlTerm}) are the elements of the list. The caller of these functions must provide the array. Functions managing compound terms handle a functor (the principal functor of the term), an arity \Param{N} $\geq$ 0 and an array of \Param{N} elements (of type \texttt{PlTerm}) containing the sub-terms of the compound term. Since a list is a special case of compound term (functor = \texttt{'.'} and arity=2) it is possible to use any function managing compound terms to deal with a list but the error detection is not the same. Indeed many functions check if the Prolog argument is correct. The name of a read or unify function checking the Prolog arguments is of the form \texttt{\Param{Name}\_Check()}. For each of these functions there is a also check-free version called \texttt{\Param{Name}()}. We then only present the name of checking functions. \subsubsection{Managing Prolog atoms} Each atom has a unique internal key (an integer) which corresponds to its index in the GNU Prolog atom table. It is possible to obtain the information about an atom and to create new atoms using: \begin{Indentation} \begin{verbatim} char *Pl_Atom_Name (int atom) int Pl_Atom_Length (int atom) PlBool Pl_Atom_Needs_Quote (int atom) PlBool Pl_Atom_Needs_Scan (int atom) PlBool Pl_Is_Valid_Atom (int atom) int Pl_Create_Atom (const char *str) int Pl_Create_Allocate_Atom(const char *str) int Pl_Find_Atom (const char *str) int Pl_Atom_Char (char c) int Pl_Atom_Nil (void) int Pl_Atom_User (void) int Pl_Atom_System (void) int Pl_Atom_False (void) int Pl_Atom_True (void) int Pl_Atom_End_Of_File (void) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Atom\_Name(atom)} returns the internal string of \texttt{atom} (this string should not be modified). The function \texttt{Pl\_Atom\_Length(atom)} returns the length (of the name) of \texttt{atom}. The function \texttt{Pl\_Atom\_Needs\_Scan(atom)} indicates if the canonical form of \texttt{atom} needs to be quoted as done by \IdxPB{writeq/2} \RefSP{write-term/3}. In that case \texttt{Pl\_Atom\_Needs\_Scan(atom)} indicates if this simply comes down to write quotes around the name of \texttt{atom} or if it necessary to scan each character of the name because there are some non-printable characters (or included quote characters). The function \texttt{Pl\_Is\_Valid\_Atom(atom)} is true only if \texttt{atom} is the internal key of an existing atom. The function \texttt{Pl\_Create\_Atom(str)} adds a new atom whose name is the content of \texttt{str} to the system and returns its internal key. If the atom already exists its key is simply returned. The string \texttt{str} passed to the function should not be modified later. The function \texttt{Pl\_Create\_Allocate\_Atom(str)} is provided when this condition cannot be ensured. It simply makes a dynamic copy of \texttt{str} (using \texttt{strdup(3)}). The function \texttt{Pl\_Find\_Atom(str)} returns the internal key of the atom whose name is \texttt{str} or \texttt{-1} if it does not exist. All atoms corresponding to a single character already exist and their key can be obtained via the function \texttt{Pl\_Atom\_Char}. For instance \texttt{Pl\_Atom\_Char('.')} is the atom associated with \texttt{'.'} (this atom is the functor of lists). The other functions return the internal key of frequently used atoms: \texttt{[]}, \texttt{user}, \texttt{system}, \texttt{false}, \texttt{true} and \texttt{end\_of\_file}. \subsubsection{Reading Prolog terms} \label{Reading-Prolog-terms} The name of all functions presented here are of the form \texttt{Pl\_Rd\_\Param{Name}\_Check()}. They all check the validity of the Prolog term to read emitting appropriate errors if necessary. Each function has a check-free version called \texttt{Pl\_Rd\_\Param{Name}()}. \SPart{Simple foreign types}: for each simple foreign type \RefSP{foreign/2-directive} there is a read function (used by the interface when an input argument is provided): \begin{Indentation} \begin{verbatim} PlLong Pl_Rd_Integer_Check (PlTerm term) PlLong Pl_Rd_Positive_Check (PlTerm term) double Pl_Rd_Float_Check (PlTerm term) double Pl_Rd_Number_Check (PlTerm term) int Pl_Rd_Atom_Check (PlTerm term) int Pl_Rd_Boolean_Check (PlTerm term) int Pl_Rd_Char_Check (PlTerm term) int Pl_Rd_In_Char_Check (PlTerm term) int Pl_Rd_Code_Check (PlTerm term) int Pl_Rd_In_Code_Check (PlTerm term) int Pl_Rd_Byte_Check (PlTerm term) int Pl_Rd_In_Byte_Check (PlTerm term) char *Pl_Rd_String_Check (PlTerm term) char *Pl_Rd_Chars_Check (PlTerm term) char *Pl_Rd_Codes_Check (PlTerm term) int Pl_Rd_Chars_Str_Check(PlTerm term, char *str) int Pl_Rd_Codes_Str_Check(PlTerm term, char *str) \end{verbatim} \end{Indentation} All functions returning a C string (\texttt{char *}) use a same buffer. The function \texttt{Pl\_Rd\_Chars\_Str\_Check()} is similar to \texttt{Pl\_Rd\_Chars\_Check()} but accepts as argument a string to store the result and returns the length of that string (which is also the length of the Prolog list). Similarly for \texttt{Pl\_Rd\_Codes\_Str\_Check()}. \SPart{Complex terms}: the following functions return the sub-arguments (terms) of complex terms as an array of \texttt{PlTerm} except \texttt{Pl\_Rd\_Proper\_List\_Check()} which returns the size of the list read (and initializes the array \texttt{element}). Refer to the introduction of this section for more information about the arguments of complex functions \RefSP{Introduction:(Manipulating-Prolog-terms)}. \begin{Indentation} \begin{verbatim} int Pl_Rd_Proper_List_Check(PlTerm term, PlTerm *arg) PlTerm *Pl_Rd_List_Check (PlTerm term) PlTerm *Pl_Rd_Compound_Check (PlTerm term, int *functor, int *arity) PlTerm *Pl_Rd_Callable_Check (PlTerm term, int *functor, int *arity) \end{verbatim} \end{Indentation} \subsubsection{Unifying Prolog terms} The name of all functions presented here are of the form \texttt{Pl\_Un\_\Param{Name}\_Check()}. They all check the validity of the Prolog term to unify emitting appropriate errors if necessary. Each function has a check-free version called \texttt{Pl\_Un\_\Param{Name}()}. \SPart{Simple foreign types}: for each simple foreign type \RefSP{foreign/2-directive} there is an unify function (used by the interface when an output argument is provided): \begin{Indentation} \begin{verbatim} PlBool Pl_Un_Integer_Check (PlLong n, PlTerm term) PlBool Pl_Un_Positive_Check(PlLong n, PlTerm term) PlBool Pl_Un_Float_Check (double n, PlTerm term) PlBool Pl_Un_Number_Check (double n, PlTerm term) PlBool Pl_Un_Atom_Check (int atom, PlTerm term) PlBool Pl_Un_Boolean_Check (int b, PlTerm term) PlBool Pl_Un_Char_Check (int c, PlTerm term) PlBool Pl_Un_In_Char_Check (int c, PlTerm term) PlBool Pl_Un_Code_Check (int c, PlTerm term) PlBool Pl_Un_In_Code_Check (int c, PlTerm term) PlBool Pl_Un_Byte_Check (int b, PlTerm term) PlBool Pl_Un_In_Byte_Check (int b, PlTerm term) PlBool Pl_Un_String_Check (const char *str, PlTerm term) PlBool Pl_Un_Chars_Check (const char *str, PlTerm term) PlBool Pl_Un_Codes_Check (const char *str, PlTerm term) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Un\_Number\_Check(n, term)} unifies \texttt{term} with an integer if \texttt{n} is an integer, with a floating point number otherwise. The function \texttt{Pl\_Un\_String\_Check(str, term)} creates the atom corresponding to \texttt{str} and then unifies term with it (same as \texttt{Pl\_Un\_Atom\_Check(Pl\_Create\_Allocate\_Atom(str), term)}). The following functions perform a general unification (between 2 terms). The second one performs a occurs-check test (while the first one does not). \begin{Indentation} \begin{verbatim} PlBool Pl_Unif(PlTerm term1, PlTerm term2) PlBool Pl_Unif_With_Occurs_Check(PlTerm term1, PlTerm term2) \end{verbatim} \end{Indentation} \SPart{Complex terms}: the following functions accept the sub-arguments (terms) of complex terms as an array of \texttt{PlTerm}. Refer to the introduction of this section for more information about the arguments of complex functions \RefSP{Introduction:(Manipulating-Prolog-terms)}. \begin{Indentation} \begin{verbatim} PlBool Pl_Un_Proper_List_Check(int size, PlTerm *arg, PlTerm term) PlBool Pl_Un_List_Check (PlTerm *arg, PlTerm term) PlBool Pl_Un_Compound_Check (int functor, int arity, PlTerm *arg, PlTerm term) PlBool Pl_Un_Callable_Check (int functor, int arity, PlTerm *arg, PlTerm term) \end{verbatim} \end{Indentation} All these functions check the type of the term to unify and return the result of the unification. Generally if an unification fails the C function returns \texttt{PL\_FALSE} to enforce a failure. However if there are several arguments to unify and if an unification fails then the C function returns \texttt{PL\_FALSE} and the type of other arguments has not been checked. Normally all error cases are tested before doing any work to be sure that the predicate fails/succeeds only if no error condition is satisfied. So a good method is to check the validity of all arguments to unify and later to do the unification (using check-free functions). Obviously if there is only one to unify it is more efficient to use a unify function checking the argument. For the other cases the interface provides a set of functions to check the type of a term. \SPart{Simple foreign types}: for each simple foreign type \RefSP{foreign/2-directive} there is check-for-unification function (used by the interface when an output argument is provided): \begin{Indentation} \begin{verbatim} void Pl_Check_For_Un_Integer (PlTerm term) void Pl_Check_For_Un_Positive(PlTerm term) void Pl_Check_For_Un_Float (PlTerm term) void Pl_Check_For_Un_Number (PlTerm term) void Pl_Check_For_Un_Atom (PlTerm term) void Pl_Check_For_Un_Boolean (PlTerm term) void Pl_Check_For_Un_Char (PlTerm term) void Pl_Check_For_Un_In_Char (PlTerm term) void Pl_Check_For_Un_Code (PlTerm term) void Pl_Check_For_Un_In_Code (PlTerm term) void Pl_Check_For_Un_Byte (PlTerm term) void Pl_Check_For_Un_In_Byte (PlTerm term) void Pl_Check_For_Un_String (PlTerm term) void Pl_Check_For_Un_Chars (PlTerm term) void Pl_Check_For_Un_Codes (PlTerm term) \end{verbatim} \end{Indentation} \SPart{Complex terms}: the following functions check the validity of complex terms: \begin{Indentation} \begin{verbatim} void Pl_Check_For_Un_List (PlTerm term) void Pl_Check_For_Un_Compound(PlTerm term) void Pl_Check_For_Un_Callable(PlTerm term) void Pl_Check_For_Un_Variable(PlTerm term) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Check\_For\_Un\_List(term)} checks if \texttt{term} can be unified with a list. This test is done for the entire list (not only for the functor/arity of \texttt{term} but also recursively on the tail of the list). The function \texttt{Pl\_Check\_For\_Un\_Variable(term)} ensures that \texttt{term} is not currently instantiated. These functions can be defined using functions to test the type of a Prolog term \RefSP{Testing-the-type-of-Prolog-terms} and functions to raise Prolog errors \RefSP{Raising-Prolog-errors}. For instance \texttt{Pl\_Check\_For\_Un\_List(term)} is defined as follows: \begin{Indentation} \begin{verbatim} void Pl_Check_For_Un_List(PlTerm term) { if (!Pl_Builtin_List_Or_Partial_List(term)) Pl_Err_Type(type_list, term); } \end{verbatim} \end{Indentation} \subsubsection{Creating Prolog terms} \label{Creating-Prolog-terms} These functions are provided to creates Prolog terms. Each function returns a \texttt{PlTerm} containing the created term. \SPart{Simple foreign types}: for each simple foreign type \RefSP{foreign/2-directive} there is a creation function: \begin{Indentation} \begin{verbatim} PlTerm Pl_Mk_Integer (PlLong n) PlTerm Pl_Mk_Positive(PlLong n) PlTerm Pl_Mk_Float (double n) PlTerm Pl_Mk_Number (double n) PlTerm Pl_Mk_Atom (int atom) PlTerm Pl_Mk_Boolean (int b) PlTerm Pl_Mk_Char (int c) PlTerm Pl_Mk_In_Char (int c) PlTerm Pl_Mk_Code (int c) PlTerm Pl_Mk_In_Code (int c) PlTerm Pl_Mk_Byte (int b) PlTerm Pl_Mk_In_Byte (int b) PlTerm Pl_Mk_String (const char *str) PlTerm Pl_Mk_Chars (const char *str) PlTerm Pl_Mk_Codes (const char *str) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Mk\_Number(n, term)} initializes \texttt{term} with an integer if \texttt{n} is an integer, with a floating point number otherwise. The function \texttt{Pl\_Mk\_String(str)} first creates an atom corresponding to \texttt{str} and then returns that Prolog atom (i.e. equivalent to \texttt{Pl\_Mk\_Atom(Pl\_Create\_Allocate\_Atom(str))}). \SPart{Complex terms}: the following functions accept the sub-arguments (terms) of complex terms as an array of \texttt{PlTerm}. Refer to the introduction of this section for more information about the arguments of complex functions \RefSP{Introduction:(Manipulating-Prolog-terms)}. \begin{Indentation} \begin{verbatim} PlTerm Pl_Mk_Proper_List(int size, const PlTerm *arg) PlTerm Pl_Mk_List (PlTerm *arg) PlTerm Pl_Mk_Compound (int functor, int arity, const PlTerm *arg) PlTerm Pl_Mk_Callable (int functor, int arity, const PlTerm *arg) \end{verbatim} \end{Indentation} \subsubsection{Testing the type of Prolog terms} \label{Testing-the-type-of-Prolog-terms} The following functions test the type of a Prolog term. Each function corresponds to a type testing built-in predicate \RefSP{var/1}. \begin{Indentation} \begin{verbatim} PlBool Pl_Builtin_Var (PlTerm term) PlBool Pl_Builtin_Non_Var (PlTerm term) PlBool Pl_Builtin_Atom (PlTerm term) PlBool Pl_Builtin_Integer (PlTerm term) PlBool Pl_Builtin_Float (PlTerm term) PlBool Pl_Builtin_Number (PlTerm term) PlBool Pl_Builtin_Atomic (PlTerm term) PlBool Pl_Builtin_Compound (PlTerm term) PlBool Pl_Builtin_Callable (PlTerm term) PlBool Pl_Builtin_List (PlTerm term) PlBool Pl_Builtin_Partial_List (PlTerm term) PlBool Pl_Builtin_List_Or_Partial_List(PlTerm term) PlBool Pl_Builtin_Fd_Var (PlTerm term) PlBool Pl_Builtin_Non_Fd_Var (PlTerm term) PlBool Pl_Builtin_Generic_Var (PlTerm term) PlBool Pl_Builtin_Non_Generic_Var (PlTerm term) int Pl_Type_Of_Term (PlTerm term) PlLong Pl_List_Length (PlTerm list) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Type\_Of\_Term(term)} returns the type of \texttt{term}, the following constants can be used to test this type (e.g. in a \texttt{switch} instruction): \begin{itemize} \item \texttt{PL\_PLV}: Prolog variable. \item \texttt{PL\_FDV}: finite domain variable. \item \texttt{PL\_INT}: integer. \item \texttt{PL\_FLT}: floating point number. \item \texttt{PL\_ATM}: atom. \item \texttt{PL\_LST}: list. \item \texttt{PL\_STC}: structure \end{itemize} The tag \texttt{PL\_LST} means a term whose principal functor is \texttt{'.'} and whose arity is 2 (recall that the empty list is the atom \texttt{[]}). The tag \texttt{PL\_STC} means any other compound term. The function \texttt{Pl\_List\_Length(list)} returns the number of elements of the \texttt{list} (\texttt{0} for the empty list). If list is not a list this function returns \texttt{-1}. \subsubsection{Comparing Prolog terms} The following functions compares Prolog terms. Each function corresponds to a comparison built-in predicate \RefSP{(==)/2}. \begin{Indentation} \begin{verbatim} PlBool Pl_Builtin_Term_Eq (PlTerm term1, PlTerm term2) PlBool Pl_Builtin_Term_Neq(PlTerm term1, PlTerm term2) PlBool Pl_Builtin_Term_Lt (PlTerm term1, PlTerm term2) PlBool Pl_Builtin_Term_Lte(PlTerm term1, PlTerm term2) PlBool Pl_Builtin_Term_Gt (PlTerm term1, PlTerm term2) PlBool Pl_Builtin_Term_Gte(PlTerm term1, PlTerm term2) \end{verbatim} \end{Indentation} All these functions are based on a general comparison function returning a negative integer if \texttt{term1} is less than \texttt{term2}, 0 if they are equal and a positive integer otherwise: \begin{Indentation} \begin{verbatim} PlLong Term_Compare(PlTerm term1, PlTerm term2) \end{verbatim} \end{Indentation} Finally, the following function gives an access to the \texttt{compare/3} built-in \RefSP{compare/3} unifying \texttt{cmp} with the atom \texttt{{\lt}}, \texttt{=} or \texttt{{\gt}} depending on the result of the comparison of \texttt{term1} and \texttt{term2}. \begin{Indentation} \begin{verbatim} PlBool Pl_Builtin_Compare(PlTerm cmp, PlTerm term1, PlTerm term2) \end{verbatim} \end{Indentation} \subsubsection{Term processing} The following functions give access to the built-in predicates: \texttt{functor/3} \RefSP{functor/3}, \texttt{arg/3} \RefSP{arg/3} and \texttt{(=..)/2} \RefSP{(=..)/2}. \begin{Indentation} \begin{verbatim} PlBool Pl_Builtin_Functor(PlTerm term, PlTerm functor, PlTerm arity) PlBool Pl_Builtin_Arg(PlTerm arg_no, PlTerm term, PlTerm sub_term) PlBool Pl_Builtin_Univ(PlTerm term, PlTerm list) \end{verbatim} \end{Indentation} The following functions make a copy of a Prolog term: \begin{Indentation} \begin{verbatim} void Pl_Copy_Term (PlTerm *dst_term, const PlTerm *src_term) void Pl_Copy_Contiguous_Term(PlTerm *dst_term, const PlTerm *src_term) int Pl_Term_Size (PlTerm term) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Copy\_Term(dst\_term, src\_term)} makes a copy of the term located at \texttt{src\_term} and stores it from the address given by \texttt{dst\_term}. The result is a contiguous term. If it can be ensured that the source term is a contiguous term (i.e. result of a previous copy) the function \texttt{Pl\_Copy\_Contiguous\_Term()} can be used instead (it is faster). In any case, sufficient space should be available for the copy (i.e. from \texttt{dst\_term}). The function \texttt{Pl\_Term\_Size(term)} returns the number of \texttt{PlTerm} needed by \texttt{term}. The following function is an utility to display a term to the console, similarly to the built-in predicate \texttt{write/1} \RefSP{write-term/3}. \begin{Indentation} \begin{verbatim} void Pl_Write(PlTerm term) \end{verbatim} \end{Indentation} This \texttt{Pl\_Write} function can be used for debugging purpose. However, it is more flexible to receive the content of the \texttt{write/1} as a C string. This can be achieved by the following functions (using repectively \texttt{write/1}, \texttt{writeq/1}, \texttt{write\_canonical/1} and \texttt{display/1} \RefSP{write-term/3} to obtain a textual representation of the term). These functions return a dynamically allocated C string (using \texttt{malloc(3)}) which can be freed by the user when no longer needed. \begin{Indentation} \begin{verbatim} char *Pl_Write_To_String(PlTerm term) char *Pl_Writeq_To_String(PlTerm term) char *Pl_Write_Canonical_To_String(PlTerm term) char *Pl_Display_To_String(PlTerm term) \end{verbatim} \end{Indentation} Finally the following function performs the opposite converstion: given a C string it returns the associated Prolog term. It uses \texttt{read\_term/2} \RefSP{read-term/3} with the option \texttt{end\_of\_term(eof)} (thus the C string does not need to terminate by a dot). \begin{Indentation} \begin{verbatim} PlTerm Pl_Read_From_String(const char *str) \end{verbatim} \end{Indentation} \subsubsection{Comparing and evaluating arithmetic expressions} The following functions compare arithmetic expressions. Each function corresponds to a comparison built-in predicate \RefSP{(=:=)/2}. \begin{Indentation} \begin{verbatim} PlBool Pl_Builtin_Eq (PlTerm expr1, PlTerm expr2) PlBool Pl_Builtin_Neq(PlTerm expr1, PlTerm expr2) PlBool Pl_Builtin_Lt (PlTerm expr1, PlTerm expr2) PlBool Pl_Builtin_Lte(PlTerm expr1, PlTerm expr2) PlBool Pl_Builtin_Gt (PlTerm expr1, PlTerm expr2) PlBool Pl_Builtin_Gte(PlTerm expr1, PlTerm expr2) \end{verbatim} \end{Indentation} The following function evaluates the expression \texttt{expr} and stores its result as a Prolog number (integer or floating point number) in \texttt{result}: \begin{Indentation} \begin{verbatim} void Pl_Math_Evaluate(PlTerm expr, PlTerm *result) \end{verbatim} \end{Indentation} This function can be followed by a read function \RefSP{Reading-Prolog-terms} to obtain the result. \subsection{Raising Prolog errors} \label{Raising-Prolog-errors} The following functions allows a C function to raise a Prolog error. Refer to the section concerning Prolog errors for more information about the effect of raising an error \RefSP{Errors}. \subsubsection{Managing the error context} When one of the following error function is invoked it refers to the implicit error context \RefSP{General-format-and-error-context}. This context indicates the name and the arity of the concerned predicate. When using a \texttt{foreign/2} declaration this context is set by default to the name and arity of the associated Prolog predicate. This can be controlled using the \IdxPO{bip\_name} option \RefSP{foreign/2-directive}. In any case, the following functions can also be used to modify this context: \begin{Indentation} \begin{verbatim} void Pl_Set_C_Bip_Name (const char *functor, int arity) void Pl_Unset_C_Bip_Name(void) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Set\_C\_Bip\_Name(functor, arity)} initializes the context of the error with \texttt{functor} and \texttt{arity} (if \texttt{arity}$<$0 only \texttt{functor} is significant). The function \texttt{Pl\_Unset\_C\_Bip\_Name()} removes such an initialization (the context is then reset to the last \texttt{Functor}/\texttt{Arity} set by a call to \IdxPB{set\_bip\_name/2} \RefSP{set-bip-name/2}. This is useful when writing a C routine to define a context for errors occurring in this routine and, before exiting to restore the previous context. \subsubsection{Instantiation error} The following function raises an instantiation error \RefSP{Instantiation-error}: \OneLine{void Pl\_Err\_Instantiation(void)} \subsubsection{Uninstantiation error} The following function raises an uninstantiation error \RefSP{Uninstantiation-error}: \OneLine{void Pl\_Err\_Uninstantiation( PlTerm culprit)} \subsubsection{Type error} The following function raises a type error \RefSP{Type-error}: \OneLine{void Pl\_Err\_Type(int atom\_type, PlTerm culprit)} \texttt{atom\_type} is (the internal key of) the atom associated with the expected type. For each type name \Param{T} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_type\_\Param{T}}. \texttt{culprit} is the argument which caused the error. \SPart{Example}: \texttt{x} is an atom while an integer was expected: \texttt{Pl\_Err\_Type(pl\_type\_integer, x)}. \subsubsection{Domain error} The following function raises a domain error \RefSP{Domain-error}: \OneLine{void Pl\_Err\_Domain(int atom\_domain, PlTerm culprit)} \texttt{atom\_domain} is (the internal key of) the atom associated with the expected domain. For each domain name \Param{D} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{domain\_\Param{D}}. \texttt{culprit} is the argument which caused the error. \SPart{Example}: \texttt{x} is $<$ 0 but should be $\geq$ 0: \texttt{Pl\_Err\_Domain(pl\_domain\_not\_less\_than\_zero, x)}. \subsubsection{Existence error} The following function raises an existence error \RefSP{Existence-error}: \OneLine{void Pl\_Err\_Existence(int atom\_object, PlTerm culprit)} \texttt{atom\_object} is (the internal key of) the atom associated with the type of the object. For each object name \Param{O} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_existence\_\Param{O}}. \texttt{culprit} is the argument which caused the error. \SPart{Example}: \texttt{x} does not refer to an existing source: \texttt{Pl\_Err\_Existence(pl\_existence\_source\_sink, x)}. \subsubsection{Permission error} The following function raises a permission error \RefSP{Permission-error}: \OneLine{void Pl\_Err\_Permission(int atom\_operation, int atom\_permission, PlTerm culprit)} \texttt{atom\_operation} is (the internal key of) the atom associated with the operation which caused the error. For each operation name \Param{O} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_permission\_operation\_\Param{O}}. \texttt{atom\_permission} is (the internal key of) the atom associated with the tried permission. For each permission name \Param{P} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_permission\_type\_\Param{P}}. \texttt{culprit} is the argument which caused the error. \SPart{Example}: reading from an output stream \texttt{x}: \texttt{Pl\_Err\_Permission(pl\_permission\_operation\_input, \\ pl\_permission\_type\_stream, x)}. \subsubsection{Representation error} The following function raises a representation error \RefSP{Representation-error}: \OneLine{void Pl\_Err\_Representation(int atom\_limit)} \texttt{atom\_limit} is (the internal key of) the atom associated with the reached limit. For each limit name \Param{L} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_representation\_\Param{L}}. \SPart{Example}: an arity too big occurs: \texttt{Pl\_Err\_Representation(pl\_representation\_max\_arity)}. \subsubsection{Evaluation error} The following function raises an evaluation error \RefSP{Evaluation-error}: \OneLine{void Pl\_Err\_Evaluation(int atom\_error)} \texttt{atom\_error} is (the internal key of) the atom associated with the error. For each evaluation error name \Param{E} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_evaluation\_\Param{E}}. \SPart{Example}: a division by zero occurs: \texttt{Pl\_Err\_Evaluation(pl\_evaluation\_zero\_divisor)}. \subsubsection{Resource error} The following function raises a resource error \RefSP{Resource-error}: \OneLine{void Pl\_Err\_Resource(int atom\_resource)} \texttt{atom\_resource} is (the internal key of) the atom associated with the resource. For each resource error name \Param{R} there is a corresponding predefined atom stored in a global variable whose name is of the form \texttt{pl\_resource\_\Param{R}}. \SPart{Example}: too many open streams: \texttt{Pl\_Err\_Resource(pl\_resource\_too\_many\_open\_streams)}. \subsubsection{Syntax error} The following function raises a syntax error \RefSP{Syntax-error}: \OneLine{void Pl\_Err\_Syntax(int atom\_error)} \texttt{atom\_error} is (the internal key of) the atom associated with the error. There is no predefined syntax error atoms. \SPart{Example}: a \texttt{/} is expected: \texttt{Pl\_Err\_Syntax(Pl\_Create\_Atom("/ expected"))}. The following function emits a syntax error according to the value of the \IdxPF{syntax\_error} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. This function can then return (if the value of the flag is either \texttt{warning} or \texttt{fail}). In that case the calling function should fail (e.g. returning \texttt{PL\_FALSE}). This function accepts a file name (the empty string C \texttt{""} can be passed), a line and column number and an error message string. Using this function makes it possible to further call the built-in predicate \IdxPB{syntax\_error\_info/4} \RefSP{syntax-error-info/4}: \OneLine{void Pl\_Emit\_Syntax\_Error(char *file\_name, int line, int column, char *message)} \SPart{Example}: a \texttt{/} is expected: \texttt{Pl\_Emit\_Syntax\_Error("data", 10, 30, "/ expected")}. \subsubsection{System error} The following function raises a system error (4.3.11, page *): \OneLine{void Pl\_Err\_System(int atom\_error)} \texttt{atom\_error} is (the internal key of) the atom associated with the error. There is no predefined system error atoms. \SPart{Example}: an invalid pathname is given: \texttt{Pl\_Err\_System(Pl\_Create\_Atom("invalid path name"))}. The following function emits a system error associated with an operating system error according to the value of the \IdxPF{os\_error} \Idx{Prolog flag} \RefSP{set-prolog-flag/2}. This function can then return (if the value of the flag is either \texttt{warning} or \texttt{fail}). In that case the calling function should fail (e.g. returning \texttt{PL\_FALSE}). The following function uses the value of the \texttt{errno} C library variable (basically it calls \texttt{Pl\_Err\_System} with the result of \texttt{strerror(errno)}). \OneLine{void Pl\_Os\_Error(void)} \SPart{Example}: if a call to the C Unix function \texttt{chdir(2)} returns \texttt{-1} then call \texttt{Os\_Error()}. \subsection{Calling Prolog from C} \subsubsection{Introduction} The following functions allows a C function to call a Prolog predicate: \begin{Indentation} \begin{verbatim} void Pl_Query_Begin (PlBool recoverable) int Pl_Query_Call (int functor, int arity, PlTerm *arg) int Pl_Query_Call_Module (int module, int functor, int arity, PlTerm *arg) int Pl_Query_Start (int functor, int arity, PlTerm *arg, PlBool recoverable) int Pl_Query_Start_Module (int module, int functor, int arity, PlTerm *arg, Plbool recoverable) int Pl_Query_Next_Solution (void) void Pl_Query_End (int op) PlTerm Pl_Get_Exception (void) void Pl_Exec_Continuation (int functor, int arity, PlTerm *arg) void Pl_Exec_Continuation_Module(int module, int functor, int arity, PlTerm *arg) void Pl_Throw (PlTerm ball) \end{verbatim} \end{Indentation} The invocation of a Prolog predicate should be done as follows: \begin{itemize} \item open a query using \texttt{Pl\_Query\_Begin()} \item compute the first solution using \texttt{Pl\_Query\_Call()}\\ (or the module-aware version \texttt{Pl\_Query\_Call\_Module()}) \item eventually compute next solutions using \texttt{Pl\_Query\_Next\_Solution()} \item close the query using \texttt{Pl\_Query\_End()} \end{itemize} The function \texttt{Pl\_Query\_Begin(recoverable)} is used to initialize a query. The argument \texttt{recoverable} shall be set to \texttt{PL\_TRUE} if the user wants to recover, at the end of the query, the memory space consumed by the query (in that case an additional choice-point is created). All terms created in the heap, e.g. using \texttt{Pl\_Mk\_...} family functions \RefSP{Creating-Prolog-terms}, after the invocation of \texttt{Pl\_Query\_Begin()} can be recovered when calling \texttt{Pl\_Query\_End(PL\_TRUE)} (see below). The function \texttt{Pl\_Query\_Call(functor, arity, arg)} calls a predicate passing arguments. It is then used to compute the first solution. The arguments \texttt{functor}, \texttt{arity} and \texttt{arg} are similar to those of the functions handling complex terms \RefSP{Introduction:(Manipulating-Prolog-terms)}. This function returns: \begin{itemize} \item \texttt{PL\_FAILURE} (a constant equal to \texttt{PL\_FALSE}, i.e. 0) if the query fails. \item \texttt{PL\_SUCCESS} (a constant equal to \texttt{PL\_TRUE}, i.e. 1) in case of success. In that case the argument array \texttt{arg} can be used to obtain the unification performed by the query. \item \texttt{PL\_EXCEPTION} (a constant equal to 2). In that case function \texttt{Pl\_Get\_Exception()} can be used to obtained the exceptional term raised by \IdxCC{throw/1} \RefSP{catch/3}. \end{itemize} The function \texttt{Pl\_Query\_Call\_Module} is similar but accepts an additionnal argument to specify the lookup module (an atom). The procedure is first searched in the specified module, then in the \texttt{user} module and finally in the \texttt{system} module. The function \texttt{Pl\_Query\_Start(functor, arity, arg, recoverable)} is a shorthand equivalent to a call to \texttt{Pl\_Query\_Begin(recoverable)} followed by a call to \texttt{Pl\_Query\_Call(functor, arity, arg)}. The function \texttt{Pl\_Query\_Start\_Module} is similar but accepts an additionnal argument to specify the lookup module (an atom). The function \texttt{Pl\_Query\_Next\_Solution()} is used to compute a new solution. It must be only used if the result of the previous solution was \texttt{PL\_SUCCESS}. This functions returns the same kind of values as \texttt{Pl\_Query\_Call()} (see above). The function \texttt{Pl\_Query\_End(op)} is used to finish a query. This function mainly manages the remaining alternatives of the query. However, even if the query has no alternatives this function must be used to correctly finish the query. The value of \texttt{op} is: \begin{itemize} \item \texttt{PL\_RECOVER}: to recover the memory space consumed by the query. After that the state of Prolog stacks is exactly the same as before opening the query. To use this option the query must have been initialized specifying \texttt{PL\_TRUE} for \texttt{recoverable} (see above). \item \texttt{PL\_CUT}: to cut remaining alternatives. The effect of this option is similar to a cut after the query. \item \texttt{PL\_KEEP\_FOR\_PROLOG}: to keep the alternatives for Prolog. This is useful when the query was invoked in a foreign C function. In that case, when the predicate corresponding to the C foreign function is invoked a query is executed and the remaining alternatives are then available as alternatives of that predicate. \end{itemize} Note that several queries can be nested since a stack of queries is maintained. For instance, it is possible to call a query and before terminating it to call another query. In that case the first execution of \texttt{Pl\_Query\_End()} will finish the second query (i.e. the inner) and the next execution of \texttt{Pl\_Query\_End()} will finish the first query. The function \texttt{Pl\_Exec\_Continuation(functor, arity, arg)} replaces the current calculus by the execution of the specified predicate. The arguments \texttt{functor}, \texttt{arity} and \texttt{arg} are similar to those of the functions handling complex terms \RefSP{Introduction:(Manipulating-Prolog-terms)}. The function \texttt{Pl\_Exec\_Continuation\_Module} is similar but accepts an additionnal argument to specify the lookup module (an atom). Finally the function \texttt{Pl\_Throw(ball)} throws an exception. See the \IdxCC{throw/1} control construct for more information on exceptions \RefSP{catch/3}. Note that \texttt{Pl\_Throw(ball)} is logically equivalent (but faster) to \texttt{Pl\_Exec\_Continuation(Pl\_Find\_Atom("throw"), 1, \&ball)} . \subsubsection{Example: \texttt{my\_call/1} - a \texttt{call/1} clone} We here define a predicate \texttt{my\_call(Goal)} which acts like \texttt{call(Goal)} except that we do not handle exceptions (if an exception occurs the goal simply fails): In the prolog file \texttt{examp.pl}: \OneLine{:- foreign(my\_call(term)).} In the C file \texttt{examp\_c.c}: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool my_call(PlTerm goal) { PlTerm *arg; int functor, arity; int result; arg = Pl_Rd_Callable_Check(goal, &functor, &arity); Pl_Query_Begin(PL_FALSE); result = Pl_Query_Call(functor, arity, arg); Pl_Query_End(PL_KEEP_FOR_PROLOG); return (result == PL_SUCCESS); } \end{verbatim} \end{Indentation} The compilation produces an executable called \texttt{examp}: \OneLine{\% gplc examp.pl examp\_c.c} Examples of use: \begin{CodeTwoCols} \One{| ?- my\_call(write(hello)).} \One{hello} \SkipLine \One{| ?- my\_call(for(X,1,3)).} \SkipLine \Two{X = 1 ?}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = 2 ?}{(here the user presses \texttt{;} to compute another solution)} \SkipLine \Two{X = 3}{(here the user is not prompted since there is no more alternative)} \SkipLine \One{| ?- my\_call(1).} \One{{\lb}exception:~error(type\_error(callable,1),my\_call/1){\rb}} \SkipLine \One{| ?- my\_call(call(1)).} \SkipLine \One{no} \end{CodeTwoCols} When \texttt{my\_call(1)} is called an error is raised due to the use of \texttt{Pl\_Rd\_Callable\_Check()}. However the error raised by \texttt{my\_call(call(1))} is ignored and \texttt{PL\_FALSE} (i.e. a failure) is returned by the foreign function. To really simulate the behavior of \texttt{call/1} when an exception is recovered it should be re-raised to be captured by an earlier handler. The idea is then to execute a \texttt{throw/1} as the continuation. This is what it is done by the following code: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool my_call(PlTerm goal) { PlTerm *args; int functor, arity; int result; args = Pl_Rd_Callable_Check(goal, &functor, &arity); Pl_Query_Begin(PL_FALSE); result = Pl_Query_Call(functor, arity, args); Pl_Query_End(PL_KEEP_FOR_PROLOG); if (result == PL_EXCEPTION) { PlTerm except = Pl_Get_Exception(); Pl_Throw(except); // equivalent to Pl_Exec_Continuation(Find_Atom("throw"), 1, &except); } return result; } \end{verbatim} \end{Indentation} The following code propagates the error raised by \texttt{call/1}. \begin{CodeTwoCols} \One{| ?- my\_call(call(1)).} \One{{\lb}exception:~error(type\_error(callable,1),my\_call/1){\rb}} \end{CodeTwoCols} Finally note that a simpler way to define \texttt{my\_call/1} is to use \texttt{Pl\_Exec\_Continuation()} as follows: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool my_call(PlTerm goal) { PlTerm *args; int functor, arity; args = Pl_Rd_Callable_Check(goal, &functor, &arity); Pl_Exec_Continuation(functor, arity, args); return PL_TRUE; } \end{verbatim} \end{Indentation} \subsubsection{Example: recovering the list of all operators} We here define a predicate \texttt{all\_op(List)} which unifies \texttt{List} with the list of all currently defined operators as would be done by: \texttt{findall(X,current\_op(\_,\_,X),List)}. In the prolog file \texttt{examp.pl}: \OneLine{:- foreign(all\_op(term)).} In the C file \texttt{examp\_c.c}: \begin{Indentation} \begin{verbatim} #include <string.h> #include <gprolog.h> PlBool all_op(PlTerm list) { PlTerm op[1024]; PlTerm args[3]; int n = 0; int result; Pl_Query_Begin(PL_TRUE); args[0] = Pl_Mk_Variable(); args[1] = Pl_Mk_Variable(); args[2] = Pl_Mk_Variable(); result = Pl_Query_Call(Find_Atom("current_op"), 3, args); while (result) { op[n++] = Pl_Mk_Atom(Pl_Rd_Atom(args[2])); /* arg[2]: the name of the op */ result = Pl_Query_Next_Solution(); } Pl_Query_End(PL_RECOVER); return Pl_Un_Proper_List_Check(n, op, list); } \end{verbatim} \end{Indentation} Note that we know here that there is no source for exception. In that case the result of \texttt{Pl\_Query\_Call} and \texttt{Pl\_Query\_Next\_Solution} can be considered as a boolean. The compilation produces an executable called \texttt{examp}: \OneLine{\% gplc examp.pl examp\_c.c} Example of use: \begin{Indentation} \begin{verbatim} | ?- all_op(L). L = [:-,:-,\=,=:=,#>=,#<#,@>=,-->,mod,#>=#,**,*,+,+,',',...] | ?- findall(X,current_op(_,_,X),L). L = [:-,:-,\=,=:=,#>=,#<#,@>=,-->,mod,#>=#,**,*,+,+,',',...] \end{verbatim} \end{Indentation} \subsection{Defining a new C \texttt{main()} function} GNU Prolog allows the user to define his own \texttt{main()} function. This can be useful to perform several tasks before starting the Prolog engine. To do this simply define a classical \texttt{main(argc, argv)} function. The following functions can then be used: \begin{Indentation} \begin{verbatim} int Pl_Start_Prolog (int argc, char *argv[]) void Pl_Stop_Prolog (void) void Pl_Reset_Prolog (void) PlBool Pl_Try_Execute_Top_Level(void) \end{verbatim} \end{Indentation} The function \texttt{Pl\_Start\_Prolog(argc, argv)} initializes the Prolog engine (\texttt{argc} and \texttt{argv} are the command-line variables). This function collects all linked objects (issued from the compilation of Prolog files) and initializes them. The initialization of a Prolog object file consists in adding to appropriate tables new atoms, new predicates and executing its system directives. A system directive is generated by the Prolog to WAM compiler to reflect a (user) directive executed at compile-time such as \texttt{op/3} \RefSP{op/3}. Indeed, when the compiler encounters such a directive it immediately executes it and also generates a system directive to execute it at the start of the executable. When all system directives have been executed the Prolog engine executes all initialization directives defined with \IdxDi{initialization/1} \RefSP{initialization/1}. The function returns the number of user directives (i.e. \texttt{initialization/1}) executed. This function must be called only once. The function \texttt{Pl\_Stop\_Prolog()} stops the Prolog engine. This function must be called only once after all Prolog treatment have been done. The function \texttt{Pl\_Reset\_Prolog()} reinitializes the Prolog engine (i.e. reset all Prolog stacks). The function \texttt{Pl\_Try\_Execute\_Top\_Level()} executes the \Idx{top-level} if linked \RefSP{Using-the-compiler} and returns \texttt{PL\_TRUE}. If the top-level is not present the functions returns \texttt{PL\_FALSE}. Here is the definition of the default GNU Prolog \texttt{main()} function: \begin{Indentation} \begin{verbatim} static int Main_Wrapper(int argc, char *argv[]) { int nb_user_directive; PlBool top_level; nb_user_directive = Pl_Start_Prolog(argc, argv); top_level = Pl_Try_Execute_Top_Level(); Pl_Stop_Prolog(); if (top_level || nb_user_directive) return 0; fprintf(stderr, "Warning: no initial goal executed\n" " use a directive :- initialization(Goal)\n" " or remove the link option --no-top-level" " (or --min-bips or --min-size)\n"); return 1; } int main(int argc, char *argv[]) { return Main_Wrapper(argc, argv); } \end{verbatim} \end{Indentation} Note that under some circumstances it is necessary to encapsulate the code of \texttt{main()} inside an intermediate function called by \texttt{main()}. Indeed, some C compilers (e.g. gcc) treats \texttt{main()} particularly, producing an incompatible code w.r.t GNU Prolog. So it is a good idea to always use a wrapper function as shown above. \subsubsection{Example: asking for ancestors} In this example we use the following Prolog code (in a file called \texttt{new\_main.pl}): \begin{Indentation} \begin{verbatim} parent(bob, mary). parent(jane, mary). parent(mary, peter). parent(paul, peter). parent(peter, john). anc(X, Y):- parent(X, Y). anc(X, Z) :- parent(X, Y), anc(Y, Z). \end{verbatim} \end{Indentation} The following file (called \texttt{new\_main\_c.c}) defines a \texttt{main()} function read the name of a person and displaying all successors of that person. This is equivalent to the Prolog query: \texttt{anc(Result, Name)}. \begin{Indentation} \begin{verbatim} static int Main_Wrapper(int argc, char *argv[]) { int func; PlTerm arg[10]; char str[100]; char *sol[100]; int i, nb_sol = 0; PlBool res; Pl_Start_Prolog(argc, argv); func = Pl_Find_Atom("anc"); for (;;) { printf("\nEnter a name (or 'end' to finish): "); fflush(stdout); scanf("%s", str); if (strcmp(str, "end") == 0) break; Pl_Query_Begin(PL_TRUE); arg[0] = Pl_Mk_Variable(); arg[1] = Pl_Mk_String(str); nb_sol = 0; res = Pl_Query_Call(func, 2, arg); while (res) { sol[nb_sol++] = Pl_Rd_String(arg[0]); res = Pl_Query_Next_Solution(); } Pl_Query_End(PL_RECOVER); for (i = 0; i < nb_sol; i++) printf(" solution: %s\n", sol[i]); printf("%d solution(s)\n", nb_sol); } Pl_Stop_Prolog(); return 0; } int main(int argc, char *argv[]) { return Main_Wrapper(argc, argv); } \end{verbatim} \end{Indentation} The compilation produces an executable called \texttt{new\_main}: \OneLine{\% gplc new\_main.pl new\_main\_c.c} Examples of use: \begin{Indentation} \begin{verbatim} Enter a name (or 'end' to finish): john solution: peter solution: bob solution: jane solution: mary solution: paul 5 solution(s) Enter a name (or 'end' to finish): mary solution: bob solution: jane 2 solution(s) Enter a name (or 'end' to finish): end \end{verbatim} \end{Indentation} %HEVEA\cutend �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/debug-box.fig���������������������������������������������������������������������0000644�0001750�0001750�00000001662�13021324543�014434� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#FIG 3.2 Landscape Center Inches Letter 100.00 Single -2 1200 2 6 4200 2700 6000 3600 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 4200 2700 6000 2700 6000 3600 4200 3600 4200 2700 4 0 0 100 0 0 12 0.0000 4 180 705 4747 3195 predicate\001 -6 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 3375 2850 4200 2850 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 6000 2850 6825 2850 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 4200 3450 3375 3450 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 3 1 1 1.00 60.00 120.00 5100 3600 5100 4050 3375 4050 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 6825 3450 6000 3450 4 0 0 100 0 0 12 0.0000 4 135 330 6900 3495 redo\001 4 0 0 100 0 0 12 0.0000 4 135 285 6900 2895 exit\001 4 2 0 100 0 0 12 0.0000 4 135 270 3300 2910 call\001 4 2 0 100 0 0 12 0.0000 4 135 240 3300 3495 fail\001 4 2 0 100 0 0 12 0.0000 4 180 735 3300 4095 exception\001 ������������������������������������������������������������������������������gprolog-1.4.5/doc/format-defs.tex�������������������������������������������������������������������0000644�0001750�0001750�00000040336�13021324543�015023� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{Format of definitions} %HEVEA\cutdef[1]{subsection} \subsection{General format} The definition of control constructs, directives and built-in predicates is presented as follows: \Templates Specifies the types of the arguments and which of them shall be instantiated (mode). Types and modes are described later \RefSP{Types-and-modes}. \Description Describes the behavior (in the absence of any error conditions). It is explicitly mentioned when a built-in predicate is re-executable on backtracking. Predefined operators involved in the definition are also mentioned. \Errors Details the error conditions. Possible errors are detailed later \RefSP{Errors}. For directives, this part is omitted. \Portability Specifies whether the definition conforms to the ISO standard or is a GNU Prolog extension. \subsection{Types and modes} \label{Types-and-modes} The templates part defines, for each argument of the concerned built-in predicate, its mode and type. The mode specifies whether or not the argument must be instantiated when the built-in predicate is called. The mode is encoded with a symbol just before the type. Possible modes are: \begin{itemize} \item \texttt{+}: the argument must be instantiated. \item \texttt{-}: the argument must be a variable (will be instantiated if the built-in predicate succeeds). \item \texttt{?}: the argument can be instantiated or a variable. \end{itemize} The type of an argument is defined by the following table: \begin{tabular}{|l|p{11.5cm}|} \hline Type & Description \\ \hline\hline \texttt{\Param{TYPE}\_list} & a list whose the type of each element is \Param{TYPE} \\ \hline \texttt{\Param{TYPE1}\_or\_\Param{TYPE2}} & a term whose type is either \Param{TYPE1} or \Param{TYPE2} \\ \hline \texttt{atom} & an atom \\ \hline \texttt{atom\_property} & an atom property \RefSP{atom-property/2} \\ \hline \texttt{boolean} & the atom \texttt{true} or \texttt{false} \\ \hline \texttt{byte} & an integer $\geq$ 0 and $\leq$ 255 \\ \hline \texttt{callable\_term} & an atom or a compound term \\ \hline \texttt{character} & a single character atom \\ \hline \texttt{character\_code} & an integer $\geq$ 1 and $\leq$ 255 \\ \hline \texttt{clause} & a clause (fact or rule) \\ \hline \texttt{close\_option} & a close option \RefSP{close/2} \\ \hline \texttt{compound\_term} & a compound term \\ \hline \texttt{evaluable} & an arithmetic expression \RefSP{Evaluation-of-an-arithmetic-expression} \\ \hline \texttt{fd\_bool\_evaluable} & a boolean FD expression \RefSP{Boolean-FD-expressions} \\ \hline \texttt{fd\_labeling\_option} & an FD labeling option \RefSP{fd-labeling/2} \\ \hline \texttt{fd\_evaluable} & an arithmetic FD expression \RefSP{FD-arithmetic-expressions} \\ \hline \texttt{fd\_variable} & an FD variable \\ \hline \texttt{flag} & a \Idx{Prolog flag} \RefSP{set-prolog-flag/2} \\ \hline \texttt{float} & a floating point number \\ \hline \texttt{head} & a head of a clause (atom or compound term) \\ \hline \texttt{integer} & an integer \\ \hline \texttt{in\_byte} & an integer $\geq$ 0 and $\leq$ 255 or \texttt{-1} (for the end-of-file) \\ \hline \texttt{in\_character} & a single character atom or the atom \texttt{end\_of\_file} (for the end-of-file) \\ \hline \texttt{in\_character\_code} & an integer $\geq$ 1 and $\leq$ 255 or \texttt{-1} (for the end-of-file) \\ \hline \texttt{io\_mode} & an atom in: \texttt{read}, \texttt{write} or \texttt{append} \\ \hline \texttt{list} & the empty list \texttt{[]} or a non-empty list \texttt{[\_|\_]} \\ \hline \texttt{nonvar} & any term that is not a variable \\ \hline \texttt{number} & an integer or a floating point number \\ \hline \texttt{operator\_specifier} & an operator specifier \RefSP{op/3:(Term-input/output)} \\ \hline \texttt{os\_file\_property} & an operating system file property \RefSP{file-property/2} \\ \hline \texttt{predicate\_indicator} & a term \texttt{Name/Arity} where \texttt{Name} is an atom and \texttt{Arity} an integer $\geq$ 0. A callable term can be given if the \IdxPF{strict\_iso} \Idx{Prolog flag} is switched off \RefSP{set-prolog-flag/2} \\ \hline \texttt{predicate\_property} & a predicate property \RefSP{predicate-property/2} \\ \hline \texttt{read\_option} & a read option \RefSP{read-term/3} \\ \hline \texttt{socket\_address} & a term of the form \texttt{'AF\_UNIX'(A)} or \texttt{'AF\_INET'(A,N)} where \texttt{A} is an atom and \texttt{N} an integer \\ \hline \texttt{socket\_domain} & an atom in: \texttt{'AF\_UNIX'} or \texttt{'AF\_INET'} \\ \hline \texttt{source\_sink} & an atom identifying a source or a sink \\ \hline \texttt{stream} & a stream-term: a term of the form \texttt{'\$stream'(N)} where \texttt{N} is an integer $\geq$ 0 \\ \hline \texttt{stream\_option} & a stream option \RefSP{open/4} \\ \hline \texttt{stream\_or\_alias} & a stream-term or an alias (atom) \\ \hline \texttt{stream\_position} & a stream position: a term \texttt{'\$stream\_position'(I1, I2, I3, I4)} where \texttt{I1}, \texttt{I2}, \texttt{I3} and \texttt{I4} are integers \\ \hline \texttt{stream\_property} & a stream property \RefSP{stream-property/2} \\ \hline \texttt{stream\_seek\_method} & an atom in: \texttt{bof}, \texttt{current} or \texttt{eof} \\ \hline \texttt{term} & any term \\ \hline \texttt{var\_binding\_option} & a variable binding option \RefSP{bind-variables/2} \\ \hline \texttt{write\_option} & a write option \RefSP{write-term/3} \\ \hline \end{tabular} \subsection{Errors} \label{Errors} \subsubsection{General format and error context} \label{General-format-and-error-context} When an error occurs an exception of the form: \texttt{error(\Param{ErrorTerm}, \Param{Caller})} is raised. \Param{ErrorTerm} is a term specifying the error (detailed in next sections) and \Param{Caller} is a term specifying the context of the error. The context is either the predicate indicator of the last invoked built-in predicate or an atom giving general context information. Using exceptions allows the user both to recover an error using \IdxPB{catch/3} \RefSP{catch/3} and to raise an error using \IdxPB{throw/1} \RefSP{catch/3}. To illustrate how to write error cases, let us write a predicate \texttt{my\_pred(X)} where \texttt{X} must be an integer: \begin{Indentation} \begin{verbatim} my_pred(X) :- ( nonvar(X) -> true ; throw(error(instantiation_error, my_pred/1)), ), ( integer(X) -> true ; throw(error(type_error(integer, X), my_pred/1)) ), ... \end{verbatim} \end{Indentation} To help the user to write these error cases, a set of system predicates is provided to raise errors. These predicates are of the form \texttt{'\$pl\_err\_...'} and they all refer to the implicit error context. The predicates \IdxPB{set\_bip\_name/2} \RefSP{set-bip-name/2} and \IdxPB{current\_bip\_name/2} \RefSP{current-bip-name/2} are provided to set and recover the name and the arity associated with this context (an arity $<$ 0 means that only the atom corresponding to the functor is significant). Using these system predicates the user could define the above predicate as follow: \begin{Indentation} \begin{verbatim} my_pred(X) :- set_bip_name(my_pred,1), ( nonvar(X) -> true ; '$pl_err_instantiation' ), ( integer(X) -> true ; '$pl_err_type'(integer, X) ), ... \end{verbatim} \end{Indentation} The following sections detail each kind of errors (and associated system predicates). \subsubsection{Instantiation error} \label{Instantiation-error} An instantiation error occurs when an argument or one of its components is variable while an instantiated argument was expected. \Param{ErrorTerm} has the following form: \texttt{instantiation\_error}. The system predicate \texttt{'\$pl\_err\_instantiation'} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Uninstantiation error} \label{Uninstantiation-error} An uninstantiation Error when an argument or one of its components is not a variable, and a variable or a component as variable is required. \Param{ErrorTerm} has the following form: \texttt{uninstantiation\_error(\Param{Culprit})} where \Param{Culprit} is the argument or one of its components which caused the error. The system predicate \texttt{'\$pl\_err\_uninstantiation'(Culprit)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Type error} \label{Type-error} A type error occurs when the type of an argument or one of its components is not the expected type (but not a variable). \Param{ErrorTerm} has the following form: \texttt{type\_error(\Param{Type}, \Param{Culprit})} where \Param{Type} is the expected type and \Param{Culprit} the argument which caused the error. \Param{Type} is one of: \begin{ItemizeThreeCols} \item \texttt{atom} \item \texttt{atomic} \item \texttt{boolean} \item \texttt{byte} \item \texttt{callable} \item \texttt{character} \item \texttt{compound} \item \texttt{evaluable} \item \texttt{fd\_bool\_evaluable} \item \texttt{fd\_evaluable} \item \texttt{fd\_variable} \item \texttt{float} \item \texttt{in\_byte} \item \texttt{in\_character} \item \texttt{integer} \item \texttt{list} \item \texttt{number} \item \texttt{pair} \item \texttt{predicate\_indicator} %\item \texttt{variable} \end{ItemizeThreeCols} The system predicate \texttt{'\$pl\_err\_type'(Type, Culprit)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Domain error} \label{Domain-error} A domain error occurs when the type of an argument is correct but its value is outside the expected domain. \Param{ErrorTerm} has the following form: \texttt{domain\_error(\Param{Domain}, \Param{Culprit})} where \Param{Domain} is the expected domain and \Param{Culprit} the argument which caused the error. \Param{Domain} is one of: \begin{ItemizeThreeCols} \item \texttt{atom\_property} \item \texttt{buffering\_mode} \item \texttt{character\_code\_list} \item \texttt{close\_option} \item \texttt{date\_time} \item \texttt{eof\_action} \item \texttt{fd\_labeling\_option} \item \texttt{flag\_value} \item \texttt{format\_control\_sequence} \item \texttt{g\_array\_index} \item \texttt{io\_mode} \item \texttt{non\_empty\_list} \item \texttt{not\_less\_than\_zero} \item \texttt{operator\_priority} \item \texttt{operator\_specifier} \item \texttt{order} \item \texttt{os\_file\_permission} \item \texttt{os\_file\_property} \item \texttt{os\_path} \item \texttt{predicate\_property} \item \texttt{prolog\_flag} \item \texttt{read\_option} \item \texttt{selectable\_item} \item \texttt{socket\_address} \item \texttt{socket\_domain} \item \texttt{source\_sink} \item \texttt{statistics\_key} \item \texttt{statistics\_value} \item \texttt{stream} \item \texttt{stream\_option} \item \texttt{stream\_or\_alias} \item \texttt{stream\_position} \item \texttt{stream\_property} \item \texttt{stream\_seek\_method} \item \texttt{stream\_type} \item \texttt{term\_stream\_or\_alias} \item \texttt{var\_binding\_option} \item \texttt{write\_option} \end{ItemizeThreeCols} The system predicate \texttt{'\$pl\_err\_domain'(Domain, Culprit)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Existence error} \label{Existence-error} an existence error occurs when an object on which an operation is to be performed does not exist. \Param{ErrorTerm} has the following form: \texttt{existence\_error(\Param{Object}, \Param{Culprit})} where \Param{Object} is the type of the object and \Param{Culprit} the argument which caused the error. \Param{Object} is one of: \begin{ItemizeThreeCols} \item \texttt{procedure} \item \texttt{source\_sink} \item \texttt{stream} \end{ItemizeThreeCols} The system predicate \texttt{'\$pl\_err\_existence'(Object, Culprit)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Permission error} \label{Permission-error} A permission error occurs when an attempt to perform a prohibited operation is made. \Param{ErrorTerm} has the following form: \texttt{permission\_error(\Param{Operation}, \Param{Permission}, \Param{Culprit})} where \Param{Operation} is the operation which caused the error, \Param{Permission} the type of the tried permission and \Param{Culprit} the argument which caused the error. \Param{Operation} is one of: \begin{ItemizeThreeCols} \item \texttt{access} \item \texttt{add\_alias} \item \texttt{close} \item \texttt{create} \item \texttt{input} \item \texttt{modify} \item \texttt{open} \item \texttt{output} \item \texttt{reposition} \end{ItemizeThreeCols} and \Param{Permission} is one of: \begin{ItemizeThreeCols} \item \texttt{binary\_stream} \item \texttt{flag} \item \texttt{operator} \item \texttt{past\_end\_of\_stream} \item \texttt{private\_procedure} \item \texttt{source\_sink} \item \texttt{static\_procedure} \item \texttt{stream} \item \texttt{text\_stream} \end{ItemizeThreeCols} The system predicate \texttt{'\$pl\_err\_permission'(Operation, Permission, Culprit)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Representation error} \label{Representation-error} A representation error occurs when an implementation limit has been breached. \Param{ErrorTerm} has the following form: \texttt{representation\_error(\Param{Limit})} where \Param{Limit} is the name of the reached limit. \Param{Limit} is one of: \begin{ItemizeThreeCols} \item \texttt{character} \item \texttt{character\_code} \item \texttt{in\_character\_code} \item \texttt{max\_arity} \item \texttt{max\_integer} \item \texttt{min\_integer} \item \texttt{too\_many\_variables} \end{ItemizeThreeCols} The errors \texttt{max\_integer} and \texttt{min\_integer} are not currently implemented. The system predicate \texttt{'\$pl\_err\_representation'(Limit)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Evaluation error} \label{Evaluation-error} An evaluation error occurs when an arithmetic expression gives rise to an exceptional value. \Param{ErrorTerm} has the following form: \texttt{evaluation\_error(\Param{Error})} where \Param{Error} is the name of the error. \Param{Error} is one of: \begin{ItemizeThreeCols} \item \texttt{float\_overflow} \item \texttt{int\_overflow} \item \texttt{undefined} \item \texttt{underflow} \item \texttt{zero\_divisor} \end{ItemizeThreeCols} The errors \texttt{float\_overflow}, \texttt{int\_overflow}, \texttt{undefined} and \texttt{underflow} are not currently implemented. The system predicate \texttt{'\$pl\_err\_evaluation'(Error)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Resource error} \label{Resource-error} A resource error occurs when GNU Prolog does not have enough resources. \Param{ErrorTerm} has the following form: \texttt{resource\_error(\Param{Resource})} where \Param{Resource} is the name of the resource. \Param{Resource} is one of: \begin{ItemizeThreeCols} \item \texttt{print\_object\_not\_linked} \item \texttt{too\_big\_fd\_constraint} \end{ItemizeThreeCols} The system predicate \texttt{'\$pl\_err\_resource'(Resource)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{Syntax error} \label{Syntax-error} A syntax error occurs when a sequence of character does not conform to the syntax of terms. \Param{ErrorTerm} has the following form: \texttt{syntax\_error(\Param{Error})} where \Param{Error} is an atom explaining the error. The system predicate \texttt{'\$pl\_err\_syntax'(Error)} raises this error in the current error context \RefSP{General-format-and-error-context}. \subsubsection{System error} A system error can occur at any stage. A system error is generally associated with an external component (e.g. operating system). \Param{ErrorTerm} has the following form: \texttt{system\_error(\Param{Error})} where \Param{Error} is an atom explaining the error. This is an extension to ISO which only defines \texttt{system\_error} without arguments. The system predicate \texttt{'\$pl\_err\_system'(Error)} raises this error in the current error context \RefSP{General-format-and-error-context}. %HEVEA\cutend ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/the-index.tex���������������������������������������������������������������������0000644�0001750�0001750�00000000014�13021324543�014466� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\printindex ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/html_node/������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021361015�014030� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/html_node/hh-gprolog.hhp����������������������������������������������������������0000644�0001750�0001750�00000000716�13021324543�016610� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������[OPTIONS] Compatibility=1.1 or later Compiled file=gprolog.chm Contents file=hh-gprolog.hhc Default Window=mainwindow Default topic=index.html Display compile progress=No Enhanced decompilation=Yes Full-text search=Yes Index file=hh-gprolog.hhk Language=0x409 Anglais (États-Unis) Title=GNU Prolog Manual [WINDOWS] mainwindow=,"hh-gprolog.hhc","hh-gprolog.hhk","index.html",,,,,,0x22520,,0x387e,,,,,,,,0 [FILES] index.html [INFOTYPES] ��������������������������������������������������gprolog-1.4.5/doc/html_node/README������������������������������������������������������������������0000644�0001750�0001750�00000000522�13021324543�014714� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������In this directory everything can be removed except some files needed to build a .chm : hh_do_hhc_hhk a script to create hh-gprolog.hhc (toc) hh-gprolog.hhk (index) hh-mkind.tex used by the script to create .hhc hh-mktoc.tex used by the script to create .hhk hh-gprolog.hhp a HTMLHelp project to build the .chm ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/html_node/.gitignore��������������������������������������������������������������0000644�0001750�0001750�00000000041�13021324543�016020� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������*.hind *.haux *.hrf *.hhc *.hhk �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/html_node/hh-mkind.tex������������������������������������������������������������0000644�0001750�0001750�00000002353�13021324543�016261� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% usefilter mode: hevea -text -w 1000 <hh-mkind.tex >hh-gprolog.hhk \documentclass{article} \usepackage{hevea} \usepackage{makeidx} \usepackage{ifpdf} %\input{../packages.tex} \input{../macros.tex} %\def\bs{\char'134} %\def\lt{\char'074} %\def\gt{\char'076} %\def\lb{\char'173} %\def\rb{\char'175} %\def\us{\char'137} \newcommand{\Tag}[1]{{\lt}#1{\gt}} \renewenvironment{indexenv}{\Tag{ul}\\}{\Tag{/ul}\\} \renewcommand{\indexspace}{\\} \renewcommand{\indexitem}[1]{% \Tag{li}\Tag{object type="text/sitemap"}\\% ~~~~\Tag{param name="Name" value="#1"}\\} \newcommand{\OneEntry}[1]{% ~~~~\Tag{param name="Local" value="#1"}\\} \newcommand{\enditem}{% ~~~~\Tag{/object}\\} \renewcommand{\@locref}[2]{\OneEntry{\csname#1\endcsname\#{}#1}} \newcommand{\see}[2]{% ~~~~\Tag{param name="See Also" value="#1"}\\} \newcommand{\remember}[2]{\def\csname#1\endcsname{#2}} \input{/tmp/gprolog.hrf.hh} \begin{document} \Tag{HTML}\\ \Tag{HEAD}\\ \Tag{!-- Sitemap 1.0 --}\\ \Tag{/HEAD}\\ \Tag{BODY}\\ %\Tag{object type="text/site properties"}\\ %~~~~\Tag{param name="FrameName" value="right"}\\ %~~~~\Tag{param name="Window Styles" value="0x800025"}\\ %\Tag{/object}\\ \input{/tmp/gprolog.hind.hh} %\input{foo.hind.hh} \Tag{/BODY}\\ \Tag{/HTML}\\ \end{document} �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/html_node/hh_do_hhc_hhk�����������������������������������������������������������0000755�0001750�0001750�00000001236�13021324543�016522� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh p=${1:-gprolog} sed -e 's!^\([^ ]*\) \(.*\)$!\\remember{\1}{\2}!' $p.hrf \ | sed -e 's!\([^\\]\)_!\1\\_!g' \ >/tmp/$p.hrf.hh hevea -text -s -w 1000 <hh-mktoc.tex | sed -e '/^----------/,$d' >hh-$p.hhc sed -e 's!^\\indexitem \([^,]*\)\(, .*\)!\\indexitem{\1}\2£\\enditem!' \ -e 's!^\\indexitem \([^,]*,[^,]*\)\(, .*\)!\\indexitem{\1}\2£\\enditem!' \ -e 's!^\\indexitem{\([^}]*\)}\(, \\see *{\(.*\)} *{\\@locref\)!\\indexitem{\1, see \3}\2!' \ -e 's!, \\!£\\!g' \ ../$p.hind \ | sed -e 's!\([^\\]\)_!\1\\_!g' \ | \tr '£' '\n' \ >/tmp/$p.hind.hh hevea -text -s -w 1000 <hh-mkind.tex | sed -e '/^----------/,$d' >hh-$p.hhk ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/html_node/hh-mktoc.tex������������������������������������������������������������0000644�0001750�0001750�00000002350�13021324543�016271� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% use filter mode: hevea -text -w 1000 <hh-mktoc.tex >hh-gprolog.hhc \documentclass{article} \usepackage{hevea} \usepackage{makeidx} \usepackage{ifpdf} %\input{../packages.tex} \input{../macros.tex} %\def\bs{\char'134} %\def\lt{\char'074} %\def\gt{\char'076} %\def\lb{\char'173} %\def\rb{\char'175} %\def\us{\char'137} \newcommand{\Tag}[1]{{\lt}#1{\gt}} \renewenvironment{tocenv}{\Tag{ul}\\}{\Tag{/ul}\\} \renewcommand{\tocitem}[1][]{} \renewcommand{\@locref}[2]{\OneEntry{\csname#1\endcsname\#{}#1}{#2}} \renewcommand{\ahrefloc}[2]{\@locref{#1}{#2}} \newcommand{\OneEntry}[2]{% \Tag{li}\Tag{object type="text/sitemap"}\\% ~~~~\Tag{param name="Name" value="{\def\\{}#2}"}\\% ~~~~\Tag{param name="Local" value="#1"}\\% ~~~~\Tag{/object}\\} \newcommand{\remember}[2]{\def\csname#1\endcsname{#2}} \input{/tmp/gprolog.hrf.hh} \begin{document} \Tag{HTML}\\ \Tag{HEAD}\\ \Tag{!-- Sitemap 1.0 --}\\ \Tag{/HEAD}\\ \Tag{BODY}\\ %\Tag{object type="text/site properties"}\\ %~~~~\Tag{param name="FrameName" value="right"}\\ %~~~~\Tag{param name="Window Styles" value="0x800025"}\\ %\Tag{/object}\\ \begin{tocenv} \OneEntry{index.html}{The GNU Prolog Manual} \input{../gprolog.htoc} %\input{foo.htoc} \end{tocenv} \Tag{/BODY}\\ \Tag{/HTML}\\ \end{document} ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/body.tex��������������������������������������������������������������������������0000644�0001750�0001750�00000001025�13021324543�013541� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\makeindex \begin{document} \input{cover.tex} \cleardoublepage \input{tbl-contents.tex} \cleardoublepage \input{acknow.tex} \cleardoublepage \input{intro.tex} \cleardoublepage \input{use.tex} \cleardoublepage \input{debugger.tex} \cleardoublepage \input{format-defs.tex} \cleardoublepage \input{direct-cc.tex} \cleardoublepage \input{pl-bips.tex} \cleardoublepage \input{fd-cstr.tex} \cleardoublepage \input{c-interface.tex} \cleardoublepage \input{references.tex} \cleardoublepage \input{the-index.tex} \end{document} �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/contents_motif.gif����������������������������������������������������������������0000644�0001750�0001750�00000000474�13021324543�015613� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GIF89a��ñ�����p€ÿÿ����!þ" Imported from XPM image: toc.xpm�!ù���,������@çÜ6313Æc „BÃ0 Ã0�‚ �A0 Ã0 Ã0 €�Á0 ƒÁ`0�€@`0 ƒÁ`�  ƒÁ`0�€@`0 ƒÁ`0�€@`0000000000� �0000000000� �00000000� �000000� �0000����� �����000000000� �00000000000� �00000000000���000`À€ ��;����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/do_latex��������������������������������������������������������������������������0000755�0001750�0001750�00000004340�13021324543�013612� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh # Daniel Diaz # LaTeX and PDF LaTeX compiler invocator # also executes makeindex and bibtex if needed # version 1.0 # Fri Jan 24 16:33:11 CET 2003 usage () { echo 'do_latex [OPTIONS] FILE' echo echo 'Options:' echo ' -dvi create a DVI file' echo ' -pdf create a PDF file' echo ' -silent redirect (pdf)latex output to /dev/null' echo ' -trace trace mode' echo ' -h this help' exit 0 } trace_msg () { test $trace = 1 && echo "$file: $*" } differ () { if diff $1 $2 >/dev/null 2>&1 then false else true fi } restore () { f=$1.$2 fp=$1.$type.$2 if test -f $fp; then trace_msg "restoring: copying $fp to $f" cp -a $fp $f fi } save () { f=$1.$2 fp=$1.$type.$2 if test ! -f $f; then return fi if test ! -f $fp || `differ $f $fp`; then trace_msg "files $f and $fp differ - redo" redo=1 fi trace_msg "files $f and $fp are identical - moving $f to $fp" mv $f $fp } one_cmd () { trace_msg "executing $1 $redir" outfile=$base.$type outfileerr=$base.err.$type eval $1 $redir err=$? if test $err = 0; then trace_msg "removing $outfileerr" rm -f $outfileerr else trace_msg "compilation error (status=$err)" if test -f $outfile; then trace_msg "moving partial resulting file $outfile to $outfileerr" mv $outfile $outfileerr fi exit $err fi } compile () { base=`dirname $file`/`basename $file .tex` for s in $suffixes; do restore $base $s done one_cmd "$compiler $file" if test -f $base.idx; then one_cmd "makeindex $base.idx" fi redo=0 if fgrep -q '\bibdata{' $base.aux; then one_cmd "bibtex $base" fi for s in $suffixes; do save $base $s done } suffixes='aux toc idx ind bbl' type=dvi compiler=latex redi='' trace=0 file_list='' while test $# -gt 0 ; do case $1 in -dvi) type=dvi; compiler=latex;; -pdf) type=pdf; compiler=pdflatex;; -silent) redir=">/dev/null";; -trace) trace=1;; -h|-help) usage;; -*) echo "unrecognized option $1 - use -f for help"; exit 1;; *) file_list="$file_list $1";; esac shift done for file in $file_list; do redo=1 while test $redo = 1; do compile done done exit 0 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/debug-box.png���������������������������������������������������������������������0000644�0001750�0001750�00000010077�13021324543�014453� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‰PNG  ��� IHDR�����X���oŸ›Ü�� )iCCPicc��xÚ•‘gP”‡†Ï÷}Û m—¥ÃÒ›T) HYz•^E–ÞY–"bCÄDiŠ ¢€‚Q)+¢X ŠXÐ,”Œ"*(÷GîLœ{'?òüzæwÎ93€"�€Š¤¤ ø~.öìÐ06|G$/3ëãã ÿÈÇQ@��¬‚%:&“�Ë�ÏKç �\�Ðʤ �£�ÀŒJJ� ç€É @n�3î/�fÔ_>�L~€Ÿ�Š Ñâ¾ó¨ïü¿{�T¸|ABlL.Û?-VÉagú¹Ø³ÝØ>ü´Ø„ä˜ïþWå@“+��pHKßÄOˆ‹°ÿo¨±¡‘üý‹÷¾€��Âüßÿ�Àw½´F�Î�¶ïï,ª {€ôÓ¿3µ£�¢…�]÷xYüì¿2��( LEP-Ðc0+°'po€PØ�<ˆ‡àCäÃ(‚Ø¡ê¡ Z ÎB7\„kpîÂ}…g „)xóð–!"t„È Jˆ:¢‹#ÄqB<?$‰@âT$ ÉGv"%H9Rƒ4 -ÈOÈärFž È,ò'òÅPÊDP Ô�å \Ô @×£qhš‡¢{Ñ*´=…v¡×лè(*Dß  `TŒ…)czsÀ¼±0,ãc[±b¬kÄÚ±^l�{€ ±9ì3Ž€càØ8=œÎˆãá2p[q¥¸ÜI\®÷�7›Ç}ÃÓñòx]¼%Þ ‚Ãçà‹ð•øf|'þ~?…ÿH XM‚9Á•JH$l&”:W ÄI‘H”!ê­‰ÞÄH¢€XD¬&ž"^!Ž§ˆŸHT’ɘäL #¥’ H•¤VÒeÒiš´D#«“-ÉÞähò&r¹‰ÜK¾Gž"/QÄ)škJ�%‘²ƒREi§Ü ŒSÞS©TªÕ—š@ÝN­¢ž¡Þ¢NP?Ó$h:4Z8-‹¶—v‚v•ö„öžN§kÐíèat}/½…~þ‚þI„!¢/â&-²M¤V¤KdDä­(YT]”+ºA4O´Rôœè=Ñ91²˜†˜ƒX¤ØV±Z± bcb â q#qoññRñVñÛâ3D '‰h‰B‰c×%&C•áÀà1v2š7SLS“éÆLd–0O3‡˜ó’’&’A’¹’µ’—$…,Œ¥Árc%³ÊXgYX_¤¤¸R1R{¤Ú¥F¤¥å¤í¤c¤‹¥;¤G¥¿È°eœd’döËtË<—ÅÉêÈúÊæÈ‘½!;'Ç”³’ãÉË•{*ÊëÈûÉo–?&?(¿  ¨à¢®P­p]aN‘¥h§˜¨X¡xYqV‰¡d£” T¡tEé5[’Íe'³«ØýìyeyeWå,åå!å%M•@•••çªUŽj¬j…jŸê¼š’š—Z¾Z›ÚSu²:G=^ýú€ú¢†¦F°ÆnnMiM7Í<Í6Íq-º–­V†V£ÖCm‚6G;Iû°ö}TÇT'^§Vçž.ªk¦› {Xwx~•ÅªÔU«Æôhz\½l½6½ }–¾§~~·þ[5ƒ0ƒýß M “ › ŸI¹õýi¬cÌ3®5~¸š¾Úyõ¶Õ=«ß™èšÄ˜1ylÊ0õ2ÝmÚgúÕÌÜŒoÖn6k®fa^g>Æar|8¥œ[x {‹m->[šY ,ÏZþa¥g•dÕj5³FsMÌš¦5“Ö*Ö‘Ö ÖB¶M„ÍQ¡­²m¤m£íK;U»h»f»i®67‘{ŠûÖÞОoßi¿è`é°Åáª#æèâXì8ä$áèTãôÂYÅ9ιÍyÞÅÔe³ËUW¼«‡ë~×177ž[‹Û¼»¹û÷~š‡¿GÇKOO¾g¯êåîuÀk|­úÚÔµÝÞàíæ}Àû¹¦O†ÏϾ_ßZßW~F~ù~þ ÿþ­þìÊžjfö‰…µ-;— C B¶„Ü • Mí #†…5‡-¬sZwpÝT¸ixQø£õšës×ßÞ »!yÃ¥¢#7ž‹ÀGG´F,GzG6F.D¹EÕEÍóx‡xo¢í¢+¢gc¬cÊc¦c­cËcgâ¬ãÄÍÆÛÆWÆÏ%8$Ô$¼KtM¬O\LòN:‘´’œÜ‘BJ‰H¹*‘š”ÚŸ¦˜–›6œ®›^”.Ì°Ì8˜1Ï÷à7g"™ë3{LAº`0K+kWÖD¶Mvmö§œ œs¹â¹©¹ƒ›t6íÙ4çœw|3n3os_¾rþŽü‰-Ü- [‘­Q[û¶©n+Ü6µÝeûÉ”I;~)0,(/ø°3xgo¡BáöÂÉ].»ÚŠDŠøEc»­v×ÿ€û!ᇡ=«÷TïùV]|§Ä°¤²d¹”WzçG£«~\Ù»w¨Ì¬ìÈ>¾Ô}öÛî?Y.^žW>yÀë@W»¢¸âÃÁoWšTÖ¢Ê:$¬ò¬ê©V«ÞW½\_3Zk_ÛQ'_·§nñpôá‘#vGÚëêKê¿M8ú¸Á¥¡«Q£±òáXö±WMAMÇ9Ç[še›Kš¿žH=!<éw²¿Å¼¥¥U¾µ¬ mËj›=~êþiÇÓ=ízí ¬Ž’3p&ëÌëŸ"~ztÖãlß9ιöóêçë:Å]Hצ®ùîønaOhÏð÷ }½V½?ëÿ|â¢òÅÚK’—Ê.S.^^¹’weájúÕ¹kq×&û6ö=»rýa¿oÿÐ ·n:ß¼>À¸rËúÖÅÛ–·/ÜáÜé¾kv·kÐt°óÓ_:‡Ì†ºî™ßë¹oq¿wxÍðåÛ‘kÜ|èöðîèÚÑáG… G?žy’üäÝÓì§K϶ãÇ‹Ÿ‹=¯|!ÿ¢ñWí_;„fÂKŽƒ/ý_>›äM¾ù-ó·å©ÂWôW•ÓJÓ-3Æ3ggï¿^÷zêMú›¥¹¢ßů{«õöüv ·ÌO½ã¿[ù³ô½ÌûL>ô-ø,¼ø˜òqi±ø“̧“Ÿ9Ÿ¾™^ÊY&.W}ÕþÚûÍãÛøJÊÊÊ�.¢¼P§î±���bKGD�ÿ‡Ì¿��� pHYs���H���H�FÉk>��úIDATxÚíÝ¿‹ädÇñ÷W;!çO°ðÈvVw<‹¶±°:›9P¯¶6™ÖFf8°ÐjmfŠã*Á ØÊaX+Ad‚vŠº÷|-’ÙdggïÜg2™lîû˜½›™Ì$áC~<ùæyDé p»ž‡-Ét±ëY8ë‰]Ï@C\OcÓÑåzr×3ИLÓ]ÏBód×3pŽ¾lmL«,6ƃÅÆ<‚Dg_ÛBldP=›ËNâòoMã±Çdù¼åÅ1ž.²ît¡7Aê¯6ͪç­úTæò£|&<Aí¸_äHîÊ­ÕøH ‰Œdɱ8™H$Næ@Œ“¸úäF'à“1$ &ÃépíçBÂÆýeBB^#–yÀ?|COÀë[9 ¿Æ5ÞâXŽù‹{|Q6)&ädDi*c¦š‚„@F®‡Õä›mm2’’锤µ•i¶Á1ÕT÷5ã8·}z³æ>Ç!èÈ%YwÄ]Ðœ¼é%”wÉù›û|­Ùú£ýž8j¾Sàg~ç÷V.\äÄŒAœf’p›ûë¿a³Øä K@Hš¶Ú¦ùQ¯Õ\¯œ³î™IDÎP"M%—¾qä„W»©Íb3f&™%b 2Cq˜*n›Æç­;͸Rþ3%½ ,¯pìÕ?)=¹A/¯Iut¹¬•Øx°ØãÁbc<XlŒ‹ñ`±1,6ƃÅæ$°×׿þ7‹ÍE$ÄËj·uŸÒ1‹ÍE¤Ëj·uV+àú¬?÷ImLbdD3&&Àé 1 "â˜èÞÚµ¢nZMÓ_›J:”€97 ud´¬vÑëTDšI$¤š Ë5™0,*àªiºx ²)¶“Z¡ r(ëÚªj·h¥ÒÍ‘ƒN5×”ðÔAr­B®¿,6“—7{8ò•jèœH N’•Ò†jš³T](BnŠÓ¬ªv㉄8yÄ­-PË%®MÓcV¦UÿŽ¤k²V¦ezÄbSY0~|ì6cÇ6'Z¸“´7lkc<XlŒ‹ñ`±1,6ƃÅÆxh$62¨w¹V\سNØú¢¨i<­ØȈ·üê¢úmû°™Ö$gë›ØÚ8]èPËlŠê·‡5YK¬¿¬»5×Ä6n%–˜HF|Ç›E[QývÎ"ßàWy‰çw°ð—š8ÞçUžã>ooñWâÕªÆeMãI‡{Æš5r\TE"Šªÿ_>HÀÜà®”½§üÉ{/ñõmô:µ{ò!ïð,Oó OðŸ4þ#ùrO!£“ªÆœG|¯S‰ˆt( ¹N%d¦{I©q3—Ó©ªF®Öj#�-ËÕº”YÔ¸­ï„MÜáNm'õâVz£ë§ßøXÓÚNêV¶©e~<¨Õ4f8¦Pô¸ù±+O¶Ù ›.øŠ¯ì؇fd°õuçVª?ç˲¦1`ÌAYûˆU÷u\W—ËZ‰‹ñ`±1,6ÆCj‰]/O¬pîË™T›:_ŽZûµNèÜ“Ø´©«'Åm²cãÁbc<XlŒ‹ñ`±1,6ƃÅÆx°ØãÁbc<XlŒ‹ñ`±1,6ƃÅÆx°ØãÁbc<XlŒ‹ñÐD'lÖAÉcg£ØH°ì«Ï<^6ˆM1íù#Õ>d:sÉÄFId$3HŽÅÉD" $‘HP{7–™Œä'‰‹‘hÅɼœz qµO¬ì¼$[rWŽøu× m6UÝÌ›T#Êʘ„©¦2:6>£¶>~m®‡ !“ëT2fì‘èPDE“gûî»äGC½Á¶MÕNª6¢¬Žq,¨?»:Þl9~måTÏn,€Þ‚ÚÌbSmmÊþÚÄi& ·±_t(*aõî9ßsªg·ÓÚè»Ï´LËŽcf1R˜pÀ5æÌ­¼;g@‚#dNŒCqL)ÄÌ 1!PÎ>Ö¿jËô¸p×]¿Ö´ÍZ‰‡‹omA7û\1íù”÷ý¾Áä���%tEXtdate:create�2013-04-23T16:33:29+02:00e²Ô���%tEXtdate:modify�2013-04-23T16:33:29+02:00K h���tEXtps:HiResBoundingBox�283x88+0+0РÊ���tEXtps:Level�Adobe-2.0 EPSF-2.0 þZ����IEND®B`‚�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/direct-cc.tex���������������������������������������������������������������������0000644�0001750�0001750�00000043460�13021324543�014452� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{Prolog directives and control constructs} %HEVEA\cutdef[1]{subsection} \subsection{Prolog directives} \subsubsection{Introduction} Prolog directives are annotations inserted in Prolog source files for the compiler. A Prolog directive is used to specify: \begin{itemize} \item the properties of some procedures defined in the source file. \item the format and the syntax for read-terms in the source file (using changeable Prolog flags). \item included source files. \item a goal to be executed at run-time. \end{itemize} \subsubsection{\IdxDiD{dynamic/1} \label{dynamic/1}} \begin{TemplatesOneCol} dynamic(+predicate\_indicator)\\ dynamic(+predicate\_indicator\_list)\\ dynamic(+predicate\_indicator\_sequence) \end{TemplatesOneCol} \Description \texttt{dynamic(Pred)} specifies that the procedure whose predicate indicator is \texttt{Pred} is a dynamic procedure. This directive makes it possible to alter the definition of \texttt{Pred} by adding or removing clauses. For more information refer to the section about dynamic clause management \RefSP{Introduction:(Dynamic-clause-management)}. This directive shall precede the definition of \texttt{Pred} in the source file. If there is no clause for \texttt{Pred} in the source file, \texttt{Pred} exists however as an empty predicate (this means that \texttt{current\_predicate(Pred)} succeeds). In order to allow multiple definitions, \texttt{Pred} can also be a list of predicate indicators or a sequence of predicate indicators using \texttt{','/2} as separator. \Portability ISO directive. \subsubsection{\IdxDiD{public/1} \label{public/1}} \begin{TemplatesOneCol} public(+predicate\_indicator)\\ public(+predicate\_indicator\_list)\\ public(+predicate\_indicator\_sequence) \end{TemplatesOneCol} \Description \texttt{public(Pred)} specifies that the procedure whose predicate indicator is \texttt{Pred} is a public procedure. This directive makes it possible to inspect the clauses of \texttt{Pred}. For more information refer to the section about dynamic clause management \RefSP{Introduction:(Dynamic-clause-management)}. This directive shall precede the definition of \texttt{Pred} in the source file. Since a dynamic procedure is also public. It is useless (but correct) to define a public directive for a predicate already declared as dynamic. In order to allow multiple definitions, \texttt{Pred} can also be a list of predicate indicators or a sequence of predicate indicators using \texttt{','/2} as separator. \Portability GNU Prolog directive. The ISO reference does not define any directive to declare a predicate public but it does distinguish public predicates. It is worth noting that in most Prolog systems the \texttt{public/1} directive is as a visibility declaration. Indeed, declaring a predicate as public makes it visible from any predicate defined in any other file (otherwise the predicate is only visible from predicates defined in the same source file as itself). When a module system is incorporated in GNU Prolog a more general visibility declaration shall be provided conforming to the ISO reference. \subsubsection{\IdxDiD{multifile/1}} \begin{TemplatesOneCol} multifile(+predicate\_indicator)\\ multifile(+predicate\_indicator\_list)\\ multifile(+predicate\_indicator\_sequence) \end{TemplatesOneCol} \Description \texttt{multifile(Pred)} specifies that the procedure whose predicate indicator is \texttt{Pred} is a multifle procedure (the clauses of \texttt{Pred} can reside in several source files). This directive is only supported by GNU Prolog since version 1.4.0. \Portability ISO directive. \subsubsection{\IdxDiD{discontiguous/1}} \begin{TemplatesOneCol} discontiguous(+predicate\_indicator)\\ discontiguous(+predicate\_indicator\_list)\\ discontiguous(+predicate\_indicator\_sequence) \end{TemplatesOneCol} \Description \texttt{discontiguous(Pred)} specifies that the procedure whose predicate indicator is \texttt{Pred} is a discontiguous procedure. Namely, the clauses defining \texttt{Pred} are not restricted to be consecutive but can appear anywhere in the source file. This directive shall precede the definition of \texttt{Pred} in the source file. In order to allow multiple definitions, \texttt{Pred} can also be a list of predicate indicators or a sequence of predicate indicators using \texttt{','/2} as separator. A multifile predicate cannot be directly called from a file where it is not declared as multifile (the native compiler must know the called predicate is multifile). Workarounds: either call it via a meta-call (e.g. using \texttt{call/1}) or declare it as multifile in the calling source file). A good habit is to encapsulate a multifile predicate in a monofile predicate which invokes it (external call only invoke the monofile wrapper predicate). \Portability ISO directive. \subsubsection{\IdxDiD{ensure\_linked/1}} \begin{TemplatesOneCol} ensure\_linked(+predicate\_indicator)\\ ensure\_linked(+predicate\_indicator\_list)\\ ensure\_linked(+predicate\_indicator\_sequence) \end{TemplatesOneCol} \Description \texttt{ensure\_linked(Pred)} specifies that the procedure whose predicate indicator is \texttt{Pred} must be included by the linker. This directive is useful when compiling to native code to force the linker to include the code of a given predicate. Indeed, if the \texttt{gplc} is invoked with an option to reduce the size of the executable \RefSP{Using-the-compiler}, the linker only includes the code of predicates that are statically referenced. However, the linker cannot detect dynamically referenced predicates (used as data passed to a meta-call predicate). The use of this directive prevents it to exclude the code of such predicates. In order to allow multiple definitions, \texttt{Pred} can also be a list of predicate indicators or a sequence of predicate indicators using \texttt{','/2} as separator. \Portability GNU Prolog directive. \subsubsection{\IdxDiD{built\_in/0}, \IdxDiD{built\_in/1}, \IdxDiD{built\_in\_fd/0}, \IdxDiD{built\_in\_fd/1}} \begin{TemplatesOneCol} built\_in\\ built\_in(+predicate\_indicator)\\ built\_in(+predicate\_indicator\_list)\\ built\_in(+predicate\_indicator\_sequence)\\ built\_in\_fd\\ built\_in\_fd(+predicate\_indicator)\\ built\_in\_fd(+predicate\_indicator\_list)\\ built\_in\_fd(+predicate\_indicator\_sequence) \end{TemplatesOneCol} \Description \texttt{built\_in} specifies that the procedures defined from now have the \IdxPP{built\_in} property \RefSP{predicate-property/2}. \texttt{built\_in(Pred)} is similar to \texttt{built\_in/0} but only affects the procedure whose predicate indicator is \texttt{Pred}. This directive shall precede the definition of \texttt{Pred} in the source file. In order to allow multiple definitions, \texttt{Pred} can also be a list of predicate indicators or a sequence of predicate indicators using \texttt{','/2} as separator. \texttt{built\_in\_fd} (resp. \texttt{built\_in\_fd(Pred)}) is similar to \texttt{built\_in} (resp. \texttt{built\_in(Pred)}) but sets the \IdxPP{built\_in\_fd} predicate property \RefSP{predicate-property/2}. \Portability GNU Prolog directives. \subsubsection{\IdxDiD{include/1}} \begin{TemplatesOneCol} include(+atom) \end{TemplatesOneCol} \Description \texttt{include(File)} specifies that the content of the Prolog source \texttt{File} shall be inserted. The resulting Prolog text is identical to the Prolog text obtained by replacing the directive by the content of the Prolog source \texttt{File}. In case of \texttt{File} is a relative file name, it is searched in the current directory. If it is not found it is then searched in each directory of parent includers. See \IdxPB{absolute\_file\_name/2} for information about the syntax of \texttt{File} \RefSP{absolute-file-name/2}. \Portability ISO directive. \subsubsection{\IdxDiD{if/1}, \IdxDiD{else/0}, \IdxDiD{endif/0}, \IdxDiD{elif/1} } \begin{TemplatesOneCol} if(+callable\_term) \\ else\\ endif\\ elif(+callable\_term) \end{TemplatesOneCol} \Description These directives are for conditional compilation. \texttt{if(Goal)} compile subsequent code only if \texttt{Goal} succeeds. \texttt{Goal} is first processed by \texttt{expand\_term/2} \RefSP{expand-term/2}. If \texttt{Goal} raises an exception it is printed and \texttt{Goal} fails. \texttt{else} introduces the \textit{else} part. \texttt{endif} terminates a conditional compilation part. \texttt{elif(Goal)} is a shorthand for \texttt{:- else. :- if(Goal). $\ldots$ :- endif}. \Portability GNU Prolog directive. Also in SWI and YAP. \subsubsection{\IdxDiD{ensure\_loaded/1}} \begin{TemplatesOneCol} ensure\_loaded(+atom) \end{TemplatesOneCol} \Description \texttt{ensure\_loaded(File)} is not supported by GNU Prolog. When such a directive is encountered it is simply ignored. \Portability ISO directive. Not supported. \subsubsection{\IdxDiD{op/3} \label{op/3}} \begin{TemplatesOneCol} op(+integer, +operator\_specifier, +atom\_or\_atom\_list) \end{TemplatesOneCol} \Description \texttt{op(Priority, OpSpecifier, Operator)} alters the operator table. This directive is executed as soon as it is encountered by calling the built-in predicate \IdxPB{op/3} \RefSP{op/3:(Term-input/output)}. A system directive is also generated to reflect the effect of this directive at run-time \RefSP{Running-an-executable}. \Portability ISO directive. \subsubsection{\IdxDiD{char\_conversion/2}} \begin{TemplatesOneCol} char\_conversion(+character, +character) \end{TemplatesOneCol} \Description \texttt{char\_conversion(InChar, OutChar)} alters the character-conversion mapping. This directive is executed as soon as it is encountered by a call to the built-in predicate \IdxPB{char\_conversion/2} \RefSP{char-conversion/2}. A system directive is also generated to reflect the effect of this directive at run-time \RefSP{Running-an-executable}. \Portability ISO directive. \subsubsection{\IdxDiD{set\_prolog\_flag/2}} \begin{TemplatesOneCol} set\_prolog\_flag(+flag, +term) \end{TemplatesOneCol} \Description \texttt{set\_prolog\_flag(Flag, Value)} sets the value of the \Idx{Prolog flag} \texttt{Flag} to \texttt{Value}. This directive is executed as soon as it is encountered by a call to the built-in predicate \IdxPB{set\_prolog\_flag/2} \RefSP{set-prolog-flag/2}. A system directive is also generated to reflect the effect of this directive at run-time \RefSP{Running-an-executable}. \Portability ISO directive. \subsubsection{\IdxDiD{initialization/1} \label{initialization/1}} \begin{TemplatesOneCol} initialization(+callable\_term) \end{TemplatesOneCol} \Description \texttt{initialization(Goal)} adds \texttt{Goal} to the set of goal which shall be executed at run-time. A user directive is generated to execute \texttt{Goal} at run-time. If several initialization directives appear in the same file they are executed in the order of appearance \RefSP{Running-an-executable}. \Portability ISO directive. \subsubsection{\IdxDiD{foreign/2}, \IdxDiD{foreign/1} \label{foreign/2}} \begin{TemplatesOneCol} foreign(+callable\_term, +foreign\_option\_list)\\ foreign(+callable\_term) \end{TemplatesOneCol} \Description \texttt{foreign(Template, Options)} defines an interface predicate whose prototype is \texttt{Template} according to the options given by \texttt{Options}. Refer to the foreign code interface for more information \RefSP{Calling-C-from-Prolog}. \texttt{foreign(Template)} is equivalent to \texttt{foreign(Template, [])}. \Portability GNU Prolog directive. \subsection{Prolog control constructs} \label{control-construct} GNU Prolog follows the ISO notion of \Idx{control constructs}. \subsubsection{\IdxCCD{true/0}, \IdxCCD{fail/0}, \AddCCD{"!/0}\texttt{!/0} \label{true/0}} % Pb with ! in \index with HeVeA \begin{TemplatesOneCol} true\\ fail\\ ! \end{TemplatesOneCol} \Description \texttt{true} always succeeds. \texttt{fail} always fails (enforces backtracking). \texttt{!} always succeeds and the for side-effect of removing all choice-points created since the invocation of the predicate activating it. \PlErrorsNone \Portability ISO control constructs. \subsubsection{\IdxCCD{(',')/2} - conjunction, \IdxCCD{(;)/2} - disjunction, \IdxCCD{(-{\gt})/2} - if-then, \IdxCCD{(*-{\gt})/2} - soft-cut (soft if-then)} \begin{TemplatesOneCol} ','(+callable\_term, +callable\_term)\\ ;(+callable\_term, +callable\_term)\\ -{\gt}(+callable\_term, +callable\_term)\\ {*-{\gt}}(+callable\_term, +callable\_term) \end{TemplatesOneCol} \Description \texttt{Goal1 , Goal2} executes \texttt{Goal1} and, in case of success, executes \texttt{Goal2}. \texttt{Goal1 ; Goal2} first creates a choice-point and executes \texttt{Goal1}. On backtracking \texttt{Goal2} is executed. \texttt{Goal1 -{\gt} Goal2} first executes \texttt{Goal1} and, in case of success, removes all choice-points created by \texttt{Goal1} and executes \texttt{Goal2}. This control construct acts like an if-then (\texttt{Goal1} is the test part and \texttt{Goal2} the then part). Note that if \texttt{Goal1} fails \texttt{-{\gt}/2} fails also. \texttt{-{\gt}/2} is often combined with \texttt{;/2} to define an if-then-else as follows: \texttt{Goal1 -{\gt} Goal2 ; Goal3}. Note that \texttt{Goal1 -{\gt} Goal2} is the first argument of the \texttt{(;)/2} and \texttt{Goal3} (the else part) is the second argument. Such an if-then-else control construct first creates a choice-point for the else-part (intuitively associated with \texttt{;/2}) and then executes \texttt{Goal1}. In case of success, all choice-points created by \texttt{Goal1} together with the choice-point for the else-part are removed and \texttt{Goal2} is executed. If \texttt{Goal1} fails then \texttt{Goal3} is executed. \texttt{Goal1 *-{\gt} Goal2 ; Goal3} implements the so-called \Idx{soft-cut}. It acts as the above if-then-else except that if \texttt{Goal1} succeeds only \texttt{Goal3} is cut (the alternative solutions of \texttt{Goal1} are preserved and can be found by backtracking). Note that \texttt{Goal1 *-{\gt} Goal2} alone (i.e. without an else branch \texttt{Goal3}) is equivalent to \texttt{(Goal1 , Goal2)}. \texttt{','}, \texttt{;}, \texttt{-{\gt}} and \texttt{*-{\gt}} are predefined infix operators \RefSP{op/3:(Term-input/output)}. \begin{PlErrors} \ErrCond{\texttt{Goal1} or \texttt{Goal2} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Goal1} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal1)} \ErrCond{\texttt{Goal2} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal2)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Goal1} or \texttt{Goal2} does not correspond to an existing procedure and the value of the \texttt{unknown} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{existence\_error(procedure, Pred)} \end{PlErrors} \Portability ISO control constructs except \texttt{(*-{\gt})/2} which is GNU Prolog specific. \subsubsection{\IdxCCD{call/1} \label{call/1}} \begin{TemplatesOneCol} call(+callable\_term) \end{TemplatesOneCol} \Description \texttt{call(Goal)} executes \texttt{Goal}. \texttt{call/1} succeeds if \texttt{Goal} represents a goal which is true. When \texttt{Goal} contains a cut symbol \AddCC{"!/0}\texttt{!} \RefSP{true/0} as a subgoal, the effect of \texttt{!} does not extend outside \texttt{Goal}. \begin{PlErrors} \ErrCond{\texttt{Goal} is a variable} \ErrTerm{instantiation\_error} \ErrCond{\texttt{Goal} is neither a variable nor a callable term} \ErrTerm{type\_error(callable, Goal)} \ErrCond{The predicate indicator \texttt{Pred} of \texttt{Goal} does not correspond to an existing procedure and the value of the \texttt{unknown} Prolog flag is \texttt{error} \RefSP{set-prolog-flag/2}} \ErrTerm{existence\_error(procedure, Pred)} \end{PlErrors} \Portability ISO control construct. \subsubsection{\IdxCCD{catch/3}, \IdxCCD{throw/1} \label{catch/3}} \begin{TemplatesOneCol} catch(?callable\_term, ?term, ?term)\\ throw(+nonvar) \end{TemplatesOneCol} \Description \texttt{catch(Goal, Catcher, Recovery)} is similar to \texttt{call(Goal)} \RefSP{call/1}. If this succeeds or fails, so does the call to \texttt{catch/3}. If however, during the execution of \texttt{Goal}, there is a call to \texttt{throw(Ball)}, the current flow of control is interrupted, and control returns to a call of \texttt{catch/3} that is being executed. This can happen in one of two ways: \begin{itemize} \item implicitly, when an error condition for a built-in predicate is satisfied. \item explicitly, when the program executes a call of \texttt{throw/1} because the program wishes to abandon the current processing, and instead to take an alternative action. \end{itemize} \texttt{throw(Ball)} causes the normal flow of control to be transferred back to an existing call of \texttt{catch/3}. When a call to \texttt{throw(Ball)} happens, \texttt{Ball} is copied and the stack is unwound back to the call to \texttt{catch/3}, whereupon the copy of \texttt{Ball} is unified with \texttt{Catcher}. If this unification succeeds, then \texttt{catch/3} executes the goal \texttt{Recovery} using \texttt{call/1} \RefSP{call/1} in order to determine the success or failure of \texttt{catch/3}. Otherwise, in case the unification fails, the stack keeps unwinding, looking for an earlier invocation of \texttt{catch/3}. \texttt{Ball} may be any non-variable term. \begin{PlErrors} \ErrCond{\texttt{Ball} is a variable} \ErrTerm{instantiation\_error} \end{PlErrors} If \texttt{Ball} does not unify with the \texttt{Catcher} argument of any call of \texttt{catch/3}, a system error message is displayed and \texttt{throw/1} fails. When \texttt{catch/3} calls \texttt{Goal} or \texttt{Recovery} it uses \texttt{call/1} \RefSP{call/1}, an \texttt{instantiation\_error}, a \texttt{type\_error} or an \texttt{existence\_error} can then occur depending on \texttt{Goal} or \texttt{Recovery}. \Portability ISO control constructs. %HEVEA\cutend ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/acknow.tex������������������������������������������������������������������������0000644�0001750�0001750�00000006053�13021324543�014074� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\newpage \section{Acknowledgements} I would like to thank the \MyUrl{http://panoramix.univ-paris1.fr/CRINFO/} {department of computing science} at the university of Paris 1 for allowing me the time and freedom necessary to achieve this project. I am grateful to the members of the \MyUrl{http://loco.inria.fr/}{Loco project} at \MyUrl{http://www.inria.fr/Unites/ROCQUENCOURT-eng.html} {INRIA Rocquencourt} for their encouragement. Their involvement in this work led to useful feedback and exchange. I would particularly like to thank \MyUrl{http://www.sju.edu/\Tilde{jhodgson}}{Jonathan Hodgson} for the time and effort he put into the proofreading of this manual. His suggestions, both regarding ISO technical aspects as well as the language in which it was expressed, proved invaluable. The on-line HTML version of this document was created using \MyUrl{http://pauillac.inria.fr/\Tilde{maranget}/hevea/}{\hevea} developed by Luc Maranget who kindly devoted so much of his time extending the capabilities of {\hevea} in order to handle such a sizeable manual. Jean-Christophe Aude kindly improved the visual aspect of both the illustrations and the GNU Prolog web pages. Thanks to Richard A. O'Keefe for his advice regarding the implementation of some Prolog built-in predicates and for suggesting me the in-place installation feature. Many thanks to the following contributors: \begin{itemize} \item \MyEMail{ax@apax.net}{Alexander Diemand} for his initial port to alpha/linux. \item \MyEMail{clive@laluna.demon.co.uk}{Clive Cox} and \MyUrl{http://www.rano.org/}{Edmund Grimley Evans} for their port to ix86/SCO. \item \MyEMail{nollinge@ens-lyon.fr}{Nicolas Ollinger} to for his port to ix86/FreeBSD. \item \MyEMail{brook@nmsu.edu}{Brook Milligan} for his port to ix86/NetBSD and for general configuration improvements. \item \MyUrl{http://www.speech.sri.com/people/stolcke/}{Andreas Stolcke} for his port to ix86/Solaris. \item \MyEMail{spratt@alum.mit.edu}{Lindsey Spratt} for his port to powerpc/Darwin (MacOS X). \item \MyEMail{gbeauchesne@mandrakesoft.com}{Gwenol\'{e} Beauchesne} for his port to x86\_64/Linux. \item \MyEMail{jtb@netbsd.org}{Jason Beegan} for his port to sparc/NetBSD and to powerpc/NetBSD. \item \MyEMail{csrabak@ig.com.br}{Cesar Rabak} for his initial port to ix86/MinGW. \item \MyEMail{Scott@coral8.com} {Scott L. Burson} for his port to x86\_64/Solaris. \item \MyEMail{dholland@netbsd.org} {David Holland} for his port to x86\_64/BSD systems. \item \MyEMail{jasper@simulistics.com} {Jasper Taylor} for his port to x86\_64/MinGW64. \item \MyEMail{gclient.gaap@gmail.com} {Ozaki Kiichi} for his port to x86\_64/Darwin (Mac OS X). \end{itemize} Many thanks to Paulo Moura for his continuous help (in particular about Darwin ports) and for including GNU Prolog in his \MyUrl{http://logtalk.org}{logtalk} system. Many thanks to all those people at \MyUrl{http://www.gnu.org}{GNU} who helped me to finalize the GNU Prolog project. Finally, I would like to thank everybody who tested preliminary releases and helped me to put the finishing touches to this system. �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/check_fp��������������������������������������������������������������������������0000755�0001750�0001750�00000001507�13021324543�013557� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh # Daniel Diaz # Manual fix-point checker # # Usage: check_fp dvi/pdf prefix [ verbose ] # # dvi/pdf: dvi to use latex, pdf to use pdflatex # prefix: LaTeX file name prefix # verbose: 0 no, 1 yes verbose_msg () { test $verbose = 1 && echo $* } differ () { if diff $1 $2 >/dev/null 2>&1 then false else true fi } copy () { f=$1.$2 fp=$f.fp if test ! -f $f; then verbose_msg "$f does not exist - rebuild (rm $res)" rm -f $res return fi if test ! -f $fp || `differ $f $fp`; then verbose_msg "$f and $fp differ - rebuild (rm $res)" cp $f $fp rm -f $res return fi verbose_msg $f and $fp are identical } type=$1 base=$2 verbose=${3:-0} if test $1 = pdf; then res=$base.pdf else res=$base.dvi fi copy $base aux copy $base toc copy $base idx exit 0 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/compil-scheme.fig�����������������������������������������������������������������0000644�0001750�0001750�00000013461�13021324543�015305� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#FIG 3.2 Portrait Center Inches A4 100.00 Single -2 1200 2 6 2587 300 3418 750 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 2587 646 2587 300 3418 300 3418 577 3 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 4 3418 577 3210 542 2864 716 2587 646 0.000 -1.000 -1.000 0.000 -6 6 2587 1800 3418 2250 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 2587 2146 2587 1800 3418 1800 3418 2077 3 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 4 3418 2077 3210 2042 2864 2216 2587 2146 0.000 -1.000 -1.000 0.000 -6 6 1800 1800 2325 2175 4 2 0 100 0 0 12 0.0000 4 135 480 2325 1950 WAM\001 4 2 0 100 0 0 12 0.0000 4 135 330 2325 2175 files\001 -6 6 1800 300 2325 675 4 2 0 100 0 0 12 0.0000 4 180 480 2325 450 Prolog\001 4 2 0 100 0 0 12 0.0000 4 135 330 2325 675 files\001 -6 6 2587 3300 3418 3750 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 2587 3646 2587 3300 3418 3300 3418 3577 3 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 4 3418 3577 3210 3542 2864 3716 2587 3646 0.000 -1.000 -1.000 0.000 -6 6 1185 3300 2325 3660 4 2 0 100 0 0 12 0.0000 4 180 1140 2325 3435 mini-assembly\001 4 2 0 100 0 0 12 0.0000 4 135 330 2325 3660 files\001 -6 6 1605 4800 2325 5160 4 2 0 100 0 0 12 0.0000 4 180 720 2325 4935 assembly\001 4 2 0 100 0 0 12 0.0000 4 135 330 2325 5160 files\001 -6 6 2587 4800 3418 5250 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 2587 5146 2587 4800 3418 4800 3418 5077 3 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 4 3418 5077 3210 5042 2864 5216 2587 5146 0.000 -1.000 -1.000 0.000 -6 6 2700 6299 3339 6899 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 3019.500 6181.000 2700 6779 3019 6859 3339 6779 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 3019.500 5821.000 2700 6419 3019 6499 3339 6419 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 3019.500 7017.000 3339 6419 3019 6339 2700 6419 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 3339 6779 3339 6419 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 2700 6419 2700 6779 -6 6 1800 6375 2325 6750 4 2 0 100 0 0 12 0.0000 4 180 465 2325 6525 object\001 4 2 0 100 0 0 12 0.0000 4 135 330 2325 6750 files\001 -6 6 2700 8025 3339 8625 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 3019.500 7907.000 2700 8505 3019 8585 3339 8505 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 3019.500 7547.000 2700 8145 3019 8225 3339 8145 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 3019.500 8743.000 3339 8145 3019 8065 2700 8145 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 3339 8505 3339 8145 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 2700 8145 2700 8505 -6 6 5426 3300 6257 3750 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 5426 3646 5426 3300 6257 3300 6257 3577 3 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 4 6257 3577 6049 3542 5703 3716 5426 3646 0.000 -1.000 -1.000 0.000 -6 6 6600 3300 7725 3675 4 0 0 100 0 0 12 0.0000 4 135 1050 6600 3450 FD constraint\001 4 0 0 100 0 0 12 0.0000 4 135 1080 6600 3675 definition files\001 -6 6 5426 4800 6257 5250 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 5426 5146 5426 4800 6257 4800 6257 5077 3 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 4 6257 5077 6049 5042 5703 5216 5426 5146 0.000 -1.000 -1.000 0.000 -6 6 5006 8025 5645 8625 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 5325.500 7907.000 5006 8505 5325 8585 5645 8505 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 5325.500 7547.000 5006 8145 5325 8225 5645 8145 5 1 0 1 -1 -1 0 0 -1 0.000 0 1 0 0 5325.500 8743.000 5645 8145 5325 8065 5006 8145 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 5645 8505 5645 8145 2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 5006 8145 5006 8505 -6 6 5850 8100 7275 8475 4 0 0 100 0 0 12 0.0000 4 180 1425 5850 8250 Prolog/FD libraries\001 4 0 0 100 0 0 12 0.0000 4 135 1305 5850 8475 and user libraries\001 -6 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 5850 6000 3375 6600 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 671 3000 975 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 2287 975 3787 975 3787 1500 2287 1500 2287 975 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 1496 3000 1800 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 2287 2475 3787 2475 3787 3000 2287 3000 2287 2475 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 2171 3000 2475 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 2996 3000 3300 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 3671 3000 3975 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 2287 3975 3787 3975 3787 4500 2287 4500 2287 3975 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 4496 3000 4800 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 5171 3000 5475 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 2287 5475 3787 5475 3787 6000 2287 6000 2287 5475 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 5996 3000 6300 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 6896 3000 7200 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 2212 7199 3712 7199 3712 7724 2212 7724 2212 7199 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 2998 7721 3000 8025 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 5849 3671 5851 3975 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 5100 3975 6600 3975 6600 4500 5100 4500 5100 3975 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 5849 4496 5851 4800 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 5849 5171 5851 5475 2 2 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 5 5100 5475 6600 5475 6600 6000 5100 6000 5100 5475 2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 1 0 2 1 1 1.00 60.00 120.00 4950 8325 3414 8325 4 2 0 100 0 14 12 0.0000 4 180 630 3375 1275 pl2wam\001 4 2 0 100 0 14 12 0.0000 4 135 630 3352 2775 wam2ma\001 4 0 0 100 0 14 12 0.0000 4 135 630 2700 4257 ma2asm\001 4 0 0 100 0 14 12 0.0000 4 135 630 2700 7518 linker\001 4 2 0 100 0 0 12 0.0000 4 135 825 2325 8400 executable\001 4 0 0 100 0 14 12 0.0000 4 135 420 5640 4275 fd2c\001 4 0 0 100 0 0 12 0.0000 4 135 495 6600 4950 C files\001 4 0 0 100 0 14 12 0.0000 4 180 1050 5325 5775 C compiler\001 4 0 0 100 0 14 12 0.0000 4 135 945 2564 5775 assembler\001 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/doc/logo.eps��������������������������������������������������������������������������0000644�0001750�0001750�00000426174�13021324543�013553� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������%!PS-Adobe-3.0 EPSF-3.0 %%Creator: (ImageMagick) %%Title: (logo.eps) %%CreationDate: (2013-04-23T16:03:45+02:00) %%BoundingBox: -0 -0 150 150 %%HiResBoundingBox: 0 0 150 150 %%DocumentData: Clean7Bit %%LanguageLevel: 1 %%Pages: 1 %%EndComments %%BeginDefaults %%EndDefaults %%BeginProlog % % Display a color image. The image is displayed in color on % Postscript viewers or printers that support color, otherwise % it is displayed as grayscale. % /DirectClassPacket { % % Get a DirectClass packet. % % Parameters: % red. % green. % blue. % length: number of pixels minus one of this color (optional). % currentfile color_packet readhexstring pop pop compression 0 eq { /number_pixels 3 def } { currentfile byte readhexstring pop 0 get /number_pixels exch 1 add 3 mul def } ifelse 0 3 number_pixels 1 sub { pixels exch color_packet putinterval } for pixels 0 number_pixels getinterval } bind def /DirectClassImage { % % Display a DirectClass image. % systemdict /colorimage known { columns rows 8 [ columns 0 0 rows neg 0 rows ] { DirectClassPacket } false 3 colorimage } { % % No colorimage operator; convert to grayscale. % columns rows 8 [ columns 0 0 rows neg 0 rows ] { GrayDirectClassPacket } image } ifelse } bind def /GrayDirectClassPacket { % % Get a DirectClass packet; convert to grayscale. % % Parameters: % red % green % blue % length: number of pixels minus one of this color (optional). % currentfile color_packet readhexstring pop pop color_packet 0 get 0.299 mul color_packet 1 get 0.587 mul add color_packet 2 get 0.114 mul add cvi /gray_packet exch def compression 0 eq { /number_pixels 1 def } { currentfile byte readhexstring pop 0 get /number_pixels exch 1 add def } ifelse 0 1 number_pixels 1 sub { pixels exch gray_packet put } for pixels 0 number_pixels getinterval } bind def /GrayPseudoClassPacket { % % Get a PseudoClass packet; convert to grayscale. % % Parameters: % index: index into the colormap. % length: number of pixels minus one of this color (optional). % currentfile byte readhexstring pop 0 get /offset exch 3 mul def /color_packet colormap offset 3 getinterval def color_packet 0 get 0.299 mul color_packet 1 get 0.587 mul add color_packet 2 get 0.114 mul add cvi /gray_packet exch def compression 0 eq { /number_pixels 1 def } { currentfile byte readhexstring pop 0 get /number_pixels exch 1 add def } ifelse 0 1 number_pixels 1 sub { pixels exch gray_packet put } for pixels 0 number_pixels getinterval } bind def /PseudoClassPacket { % % Get a PseudoClass packet. % % Parameters: % index: index into the colormap. % length: number of pixels minus one of this color (optional). % currentfile byte readhexstring pop 0 get /offset exch 3 mul def /color_packet colormap offset 3 getinterval def compression 0 eq { /number_pixels 3 def } { currentfile byte readhexstring pop 0 get /number_pixels exch 1 add 3 mul def } ifelse 0 3 number_pixels 1 sub { pixels exch color_packet putinterval } for pixels 0 number_pixels getinterval } bind def /PseudoClassImage { % % Display a PseudoClass image. % % Parameters: % class: 0-PseudoClass or 1-Grayscale. % currentfile buffer readline pop token pop /class exch def pop class 0 gt { currentfile buffer readline pop token pop /depth exch def pop /grays columns 8 add depth sub depth mul 8 idiv string def columns rows depth [ columns 0 0 rows neg 0 rows ] { currentfile grays readhexstring pop } image } { % % Parameters: % colors: number of colors in the colormap. % colormap: red, green, blue color packets. % currentfile buffer readline pop token pop /colors exch def pop /colors colors 3 mul def /colormap colors string def currentfile colormap readhexstring pop pop systemdict /colorimage known { columns rows 8 [ columns 0 0 rows neg 0 rows ] { PseudoClassPacket } false 3 colorimage } { % % No colorimage operator; convert to grayscale. % columns rows 8 [ columns 0 0 rows neg 0 rows ] { GrayPseudoClassPacket } image } ifelse } ifelse } bind def /DisplayImage { % % Display a DirectClass or PseudoClass image. % % Parameters: % x & y translation. % x & y scale. % label pointsize. % image label. % image columns & rows. % class: 0-DirectClass or 1-PseudoClass. % compression: 0-none or 1-RunlengthEncoded. % hex color packets. % gsave /buffer 512 string def /byte 1 string def /color_packet 3 string def /pixels 768 string def currentfile buffer readline pop token pop /x exch def token pop /y exch def pop x y translate currentfile buffer readline pop token pop /x exch def token pop /y exch def pop currentfile buffer readline pop token pop /pointsize exch def pop /Times-Roman findfont pointsize scalefont setfont x y scale currentfile buffer readline pop token pop /columns exch def token pop /rows exch def pop currentfile buffer readline pop token pop /class exch def pop currentfile buffer readline pop token pop /compression exch def pop class 0 gt { PseudoClassImage } { DirectClassImage } ifelse } bind def %%EndProlog %%Page: 1 1 %%PageBoundingBox: 0 0 150 150 userdict begin DisplayImage 0 0 150 150 12 150 150 0 0 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000050C00081300 060F00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000010400020800 050F000A1D00184601296E02327C033F9703469F050F2301000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000400010700 010800020E000B3600135A001B7400248D0030AD0043DF0049E1014FE30454E4055BE5045BDA05 275B03000100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000500021100 031800031F00073D000A54000D6A0011850017A50021D60025DA002ADE002EE20033E60038E600 3DE50043E50048E5004EE50353E50458E005337D03050D00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000300020D00 021500031B00073C00084E000C75000D81000F9E0010B40012C70014D20015DC0018E90019E800 1BE7001EE50021E50025E5002AE50030E50035E5003AE50040E50146E5014DE50253E6043B9903 091600000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 000000000000041E000841000D6C0010880012A60014C00015D50013DB0012DE0011E60010E600 0FE6000EE5000DE5000DE5000EE5000FE50011E50014E50017E5001BE50020E50025E5002CE500 32E50038E5003DE50045E5004BE60241B703081400000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000020E00 021000031700062C000946000C60000E7100139F0015B70019E50017E50014E50012E4000FE500 0DE5000AE50008E50007E50005E50004E50003E50002E50002E50002E50002E50003E50005E500 07E5000AE5000FE50014E50019E6001FE70026E8002CE30030D90032CE0038C60035A1010C2500 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000020C00 031200052000062C000B4D000E67000F7300139A0013A00017CA0016D10015DA0014E40012E800 0FE7000DE6000AE50008E50006E50004E50002E50001E50001E50001E50000E50000E50000E500 00E50000E50000E50000E50000E60000E70000E80001E30002D80006CC000BC60016B40522A30A 2D8F113E90165C94247A95387384361B220C000100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000000000000200 010500010900020D00093B000F6200127E0015990015A80019C90017CE0016D90016E40014E800 11E6000FE6000CE50009E50007E50005E50003E50002E50001E50001E50000E50000E50000E500 00E50000E50000E50000E50000E50000E50000E50000E40000E40000E40000E40003C60105A602 0A6D0418740A46861D7B98348EA03DA7B549C2C856E2DF67E6E46BF1F073F9F97A6C6C35080804 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000400 010A00020C000211000837000B4A000F6D00128B0017AF001DE1001BE50019E50016E50014E500 11E5000FE5000CE5000AE50008E50006E50004E50002E50001E50000E50000E50000E50000E500 00E50000E50000E50000E50000E50000E50000E50000E40000DD0000D90000D30003BF0107A903 0D8F051583083E8117527F1F74742F97973CBCBC4BFFFF64FFFF66FFFF67FFFF6AFFFF6CFFFF6E FFFF6FFFFF73FFFF75FBFB768D8D44050502FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000010500 031200041A00052100093F000B4E000E6A0012830015A20019C50019D50018DC0016E00015E700 12E60010E6000DE5000BE50008E50007E50005E50003E50002E50001E50001E50000E50000E500 00E50000E50000E50000E50000E50000E70000E70000E70000DA0000D40000C10003B9010FAB06 1B9E0A29920F488F1A598D2077862D939F37B4BA42D7D751E3E257EFEE5AF5F55CFFFF60FFFF61 FFFF61FFFF62FFFF63FFFF65FFFF67FFFF6AFFFF6DFFFF6FFFFF71FBFB749E9E4A0B0B05000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000100 010A00020E00031700093A000B4E00117600128400159F0017B50018C70017D20016D80016E800 14E80011E7000FE6000CE5000AE50007E50005E50004E50002E50001E50001E50000E50000E500 00E50000E50000E50000E50000E50000E50000E60000E50000E00000DD0000D60003C6010BA904 138F07197A093A86154D8D1C89A03294A936AFBB3FC6CA48DCD950ECEA55F4F357FFFF5CFFFF5B FFFF5AFFFF5AFFFF5AFFFF5AFFFF5BFFFF5CFFFF5DFFFF5EFFFF60FFFF62FFFF63FFFF66FFFF68 FFFF6CFFFF6EFEFE70BDBD56262611FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000 000200000200000200051E000A4100106900117C0016A40018B7001BDA001ADE0018E00016E500 14E50011E5000FE5000CE5000AE50008E50005E50004E50002E50001E50001E50000E50000E500 00E50000E50000E50000E50000E50000E50000E50000E50000E40000E30000E10000D90001B000 028B00057102317A12477E1A74852C929936B6BB43D8D94FF4F358F8F759FAF959FFFF5AFFFF59 FFFF59FFFF58FFFF57FFFF56FFFF56FFFF55FFFF55FFFF55FFFF56FFFF56FFFF57FFFF57FFFF59 FFFF5AFFFF5BFFFF5EFFFF60FFFF62FFFF64FFFF67FFFF6BFFFF6DE4E464393919000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000100000000000000 020B00031200041A00072E000B47000D5A000F6C0014920015A7001CDD001AE10018E20016E400 14E50011E5000FE5000CE5000AE50008E50006E50004E50003E50001E50001E50000E50000E500 00E50000E50000E50000E50000E50000E60000E70000E80000E20000D70000CA0000C40009B403 13A6071F940B338E134C871C687C28797E2EADAF40D6D750F0EF5AF5F55BF8F75AFDFD5AFFFF5A FFFF59FFFF58FFFF58FFFF57FFFF56FFFF55FFFF54FFFF53FFFF52FFFF52FFFF52FFFF52FFFF52 FFFF52FFFF51FFFF52FFFF52FFFF53FFFF54FFFF56FFFF58FFFF59FFFF5BFFFF5EFFFF60FFFF63 FFFF66FFFF6BEFEF693E3E1B010101FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF010700000000020C000724000C430013730017920018A2001CC6001BCF0019D80018E000 16E90013E70011E7000EE5000BE50009E50007E50005E50003E50002E50001E50001E50000E500 00E50000E50000E50000E50000E50000E60000E60000E70000E30000D90000D00000C8000AB204 11A70623890D2D8B114D911C74982B849C31A1B13BBDC445D8D451E3E054EFED57FBFA5AFFFF5B FFFF5AFFFF59FFFF58FFFF57FFFF56FFFF55FFFF55FFFF54FFFF53FFFF53FFFF52FFFF52FFFF50 FFFF4FFFFF4FFFFF4EFFFF4EFFFF4EFFFF4DFFFF4EFFFF4EFFFF4EFFFF4FFFFF4FFFFF51FFFF52 FFFF53FFFF55FFFF58FFFF5AFFFF5DFFFF60FFFF63FFFF66EFEF65707030000000000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF000000000000000000041400062000115D001B9D0020CC001FDA00 1EE70019E60016E60012E5000FE5000BE50008E50006E50003E50002E50001E50001E50000E500 00E50000E50000E50000E50000E50000E50000E50000E50000E50000E60000E60000E60001C700 01A400027701126E07407F186B8E278E9B34A8B43EB9C144E6E454EBE955F4F358FDFC5BFFFF5C FFFF5AFFFF59FFFF58FFFF58FFFF57FFFF56FFFF56FFFF55FFFF54FFFF53FFFF52FFFF52FFFF51 FFFF50FFFF50FFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4CFFFF4BFFFF4BFFFF4BFFFF4BFFFF4B FFFF4BFFFF4BFFFF4CFFFF4DFFFF4DFFFF4EFFFF50FFFF52FFFF54FFFF57FFFF59FFFF5CFFFF60 FFFF63FCFC669B9B400D0D05FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000200020E00 0D4B001B9F0023E1001FE6001AE50015E50010E5000CE50008E50005E50003E50001E50000E500 00E50000E50000E50000E50000E50000E50000E60000E60000E60000DE0000DA0000CE0003BE01 0AAB031294061A8809418118547C1E716D2C959238BEBC46EDEC58FFFF5EFFFF5CFFFF5BFFFF5A FFFF59FFFF58FFFF58FFFF57FFFF57FFFF56FFFF55FFFF55FFFF54FFFF53FFFF52FFFF52FFFF51 FFFF50FFFF4FFFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4CFFFF4BFFFF4AFFFF4AFFFF48FFFF48 FFFF48FFFF47FFFF47FFFF46FFFF46FFFF46FFFF47FFFF47FFFF48FFFF49FFFF49FFFF4BFFFF4C FFFF4EFFFF51FFFF53FFFF56FFFF59FFFF5CFFFF60FFFF63AEAE46121207FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000100051900105B001EB40020DE001CE60016E50010E5000AE50006E500 03E50001E50000E50000E50000E50000E50000E70000E70000E90000DF0000D50000C80004BB01 10AC061C9E0A27920E41921850911D7A8D2E94A337B3BB42D3D34FDFDD54EDEC57F4F358FFFF5C FFFF5AFFFF59FFFF58FFFF58FFFF57FFFF56FFFF56FFFF55FFFF54FFFF53FFFF53FFFF52FFFF52 FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4DFFFF4DFFFF4CFFFF4BFFFF4BFFFF4AFFFF49FFFF48 FFFF47FFFF47FFFF46FFFF45FFFF44FFFF44FFFF44FFFF43FFFF43FFFF43FFFF42FFFF42FFFF42 FFFF43FFFF43FFFF45FFFF46FFFF48FFFF49FFFF4BFFFF4DFFFF50FFFF53FFFF56FFFF5AFFFF5D FEFE61C5C54E21210D010100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000209000E50001EB50020DF00 1BE60014E5000DE50007E50003E50001E50000E50000E50000E50000E10000E10000DD0002CD01 09AB030C9A041373072A7F0F4D8B1C7A9A2D96A937B0BD40CACD4ADEDA51EAE855F0EF56FFFF5C FFFF5BFFFF5AFFFF58FFFF58FFFF57FFFF56FFFF56FFFF55FFFF54FFFF53FFFF53FFFF52FFFF52 FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4EFFFF4DFFFF4CFFFF4BFFFF4BFFFF4AFFFF49FFFF49 FFFF48FFFF47FFFF46FFFF46FFFF45FFFF44FFFF44FFFF43FFFF42FFFF41FFFF41FFFF40FFFF40 FFFF3FFFFF3FFFFF3FFFFF3FFFFF3FFFFF3FFFFF40FFFF41FFFF41FFFF42FFFF44FFFF46FFFF49 FFFF4AFFFF4DFFFF50FFFF53FFFF57FFFF5AFEFE5FDFDF563A3A16000000FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 0001000001000729001CA30021E1001AE50012E5000BE50005E50001E50000E50000E50000E000 00CD00029E0107770225640E48811B6F7F2A8C9035B6B843CACC4AF9F95BFBFA5AFCFC5AFEFE5A FFFF5AFFFF59FFFF58FFFF58FFFF57FFFF56FFFF56FFFF55FFFF54FFFF53FFFF53FFFF52FFFF52 FFFF51FFFF50FFFF50FFFF4FFFFF4EFFFF4EFFFF4DFFFF4CFFFF4CFFFF4BFFFF4AFFFF4AFFFF49 FFFF48FFFF47FFFF47FFFF46FFFF45FFFF45FFFF44FFFF43FFFF43FFFF42FFFF41FFFF40FFFF40 FFFF3FFFFF3EFFFF3EFFFF3DFFFF3DFFFF3CFFFF3CFFFF3BFFFF3BFFFF3BFFFF3BFFFF3CFFFF3C FFFF3DFFFF3EFFFF3FFFFF41FFFF42FFFF45FFFF48FFFF4AFFFF4DFFFF51FFFF54FFFF58FFFF5C ECEC59565621000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF031400031200136D0023DC001CE50014E5000BE500 05E50001E50000E70000DF0000BA000F92063867156E792AA1A53EDDDC54EEEE5BF5F45AFCFC5B FFFF5BFFFF59FFFF59FFFF58FFFF57FFFF56FFFF55FFFF55FFFF54FFFF53FFFF53FFFF52FFFF51 FFFF51FFFF50FFFF50FFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4BFFFF4BFFFF4AFFFF4AFFFF49 FFFF48FFFF47FFFF46FFFF46FFFF45FFFF44FFFF44FFFF43FFFF43FFFF42FFFF41FFFF40FFFF40 FFFF3FFFFF3EFFFF3EFFFF3EFFFF3DFFFF3CFFFF3BFFFF3BFFFF3AFFFF3AFFFF3AFFFF39FFFF39 FFFF39FFFF39FFFF39FFFF39FFFF39FFFF39FFFF3AFFFF3BFFFF3CFFFF3DFFFF40FFFF41FFFF45 FFFF48FFFF4BFFFF4EFFFF52FFFF55FFFF5AF8F85B686827070703FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 07280019960021E20018E5000FE50006E50001E50000E50000DB0004A1011D6E0B657E26B0B142 E3E256FCFC5DFFFF5DFFFF5AFFFF59FFFF58FFFF57FFFF55FFFF55FFFF54FFFF53FFFF52FFFF51 FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4EFFFF4DFFFF4CFFFF4CFFFF4BFFFF4BFFFF4AFFFF49 FFFF48FFFF47FFFF47FFFF46FFFF45FFFF45FFFF44FFFF43FFFF43FFFF42FFFF41FFFF40FFFF40 FFFF3FFFFF3FFFFF3EFFFF3EFFFF3DFFFF3CFFFF3CFFFF3BFFFF3BFFFF3AFFFF3AFFFF39FFFF39 FFFF39FFFF38FFFF37FFFF37FFFF36FFFF36FFFF36FFFF35FFFF35FFFF35FFFF35FFFF36FFFF37 FFFF38FFFF39FFFF3AFFFF3DFFFF3FFFFF41FFFF45FFFF48FFFF4BFFFF4FFFFF53FFFF57F9F95A 9898380B0B04FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000009310021C5001EE40014E5000AE50003E50000E500 00E30000A600145408838832DEDD53FBFB5CFFFF5CFFFF5AFFFF59FFFF57FFFF56FFFF54FFFF53 FFFF52FFFF51FFFF50FFFF50FFFF4FFFFF4EFFFF4DFFFF4DFFFF4DFFFF4BFFFF4BFFFF4AFFFF49 FFFF48FFFF48FFFF47FFFF46FFFF46FFFF45FFFF44FFFF44FFFF43FFFF42FFFF42FFFF41FFFF40 FFFF40FFFF3FFFFF3EFFFF3EFFFF3EFFFF3CFFFF3CFFFF3CFFFF3BFFFF3AFFFF3AFFFF39FFFF39 FFFF39FFFF39FFFF38FFFF38FFFF37FFFF36FFFF35FFFF33FFFF32FFFF32FFFF31FFFF31FFFF30 FFFF30FFFF30FFFF30FFFF31FFFF33FFFF34FFFF34FFFF35FFFF38FFFF3AFFFF3CFFFF3EFFFF41 FFFF45FFFF49FFFF4CFFFF50FFFF54FFFF5AB6B6430F0F06000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000106000D4A00 21D5001AE50010E50006E50000E50000E50000C70011680673772CE7E757FEFE5DFFFF5BFFFF59 FFFF57FFFF55FFFF53FFFF52FFFF51FFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4BFFFF4AFFFF49 FFFF48FFFF48FFFF47FFFF46FFFF45FFFF45FFFF43FFFF43FFFF42FFFF42FFFF41FFFF41FFFF40 FFFF3FFFFF3EFFFF3EFFFF3EFFFF3DFFFF3CFFFF3BFFFF3BFFFF3AFFFF3AFFFF39FFFF39FFFF38 FFFF38FFFF38FFFF37FFFF37FFFF36FFFF35FFFF35FFFF33FFFF32FFFF31FFFF31FFFF30FFFF2F FFFF2EFFFF2EFFFF2DFFFF2DFFFF2CFFFF2CFFFF2BFFFF2CFFFF2CFFFF2CFFFF2DFFFF2EFFFF2F FFFF32FFFF33FFFF35FFFF38FFFF3BFFFF3DFFFF41FFFF45FFFF49FFFF4DFFFF52FFFF57BDBD43 1D1D0A000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF000000010500105F0021D70019E5000EE50005E50000E50000DA00059202 46651AB7B547F5F55BFFFF5CFFFF59FFFF57FFFF54FFFF53FFFF51FFFF50FFFF4EFFFF4DFFFF4B FFFF4AFFFF4AFFFF49FFFF48FFFF47FFFF46FFFF45FFFF44FFFF44FFFF43FFFF42FFFF41FFFF40 FFFF40FFFF3FFFFF3EFFFF3EFFFF3DFFFF3DFFFF3CFFFF3BFFFF3BFFFF3AFFFF3AFFFF3AFFFF39 FFFF38FFFF38FFFF37FFFF37FFFF36FFFF36FFFF35FFFF34FFFF33FFFF32FFFF31FFFF30FFFF30 FFFF2FFFFF2EFFFF2EFFFF2DFFFF2CFFFF2CFFFF2BFFFF2AFFFF2AFFFF2AFFFF29FFFF28FFFF28 FFFF28FFFF28FFFF29FFFF29FFFF2AFFFF2BFFFF2DFFFF2FFFFF32FFFF34FFFF37FFFF3BFFFF3D FFFF41FFFF46FFFF4AFFFF4FFFFF53DADA4C464619000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000200105A0020D600 19E5000DE50003E50000E50000D4000F68067D8630E9E857FFFF5DFFFF5AFFFF57FFFF55FFFF53 FFFF50FFFF4FFFFF4DFFFF4BFFFF4AFFFF49FFFF48FFFF46FFFF46FFFF45FFFF44FFFF43FFFF42 FFFF41FFFF41FFFF40FFFF3FFFFF3EFFFF3DFFFF3DFFFF3CFFFF3CFFFF3BFFFF3AFFFF3AFFFF39 FFFF39FFFF39FFFF38FFFF38FFFF37FFFF36FFFF35FFFF34FFFF33FFFF32FFFF32FFFF31FFFF30 FFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2CFFFF2CFFFF2BFFFF2AFFFF2AFFFF29FFFF28FFFF27 FFFF27FFFF26FFFF26FFFF26FFFF25FFFF25FFFF25FFFF25FFFF25FFFF25FFFF26FFFF27FFFF28 FFFF2AFFFF2CFFFF30FFFF33FFFF37FFFF3BFFFF3EFFFF41FFFF47FFFF4BFFFF50FAFA564E4E1B 030301FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF0000000C3F0023E50018E5000CE50002E50000E50000C900174709B7B747 FBFB5DFFFF5BFFFF57FFFF55FFFF53FFFF50FFFF4EFFFF4CFFFF4AFFFF49FFFF48FFFF46FFFF45 FFFF43FFFF43FFFF42FFFF40FFFF40FFFF3FFFFF3EFFFF3EFFFF3DFFFF3CFFFF3BFFFF3BFFFF3A FFFF39FFFF39FFFF38FFFF39FFFF38FFFF37FFFF36FFFF35FFFF33FFFF33FFFF31FFFF30FFFF30 FFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2CFFFF2BFFFF2BFFFF2AFFFF2AFFFF29FFFF28FFFF27 FFFF27FFFF26FFFF26FFFF25FFFF25FFFF24FFFF24FFFF23FFFF22FFFF21FFFF21FFFF21FFFF20 FFFF20FFFF21FFFF21FFFF21FFFF22FFFF24FFFF26FFFF27FFFF2BFFFF2EFFFF32FFFF35FFFF3B FFFF3EFFFF42FFFF48FFFF4DF2F24F616122010100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0417000A3A001FC90018E500 0DE50002E50000E50003A901356014BDBD49FEFE5DFFFF5AFFFF56FFFF53FFFF51FFFF4FFFFF4D FFFF4AFFFF48FFFF47FFFF45FFFF43FFFF42FFFF41FFFF40FFFF3FFFFF3EFFFF3EFFFF3DFFFF3C FFFF3BFFFF3BFFFF3AFFFF3AFFFF39FFFF39FFFF38FFFF38FFFF37FFFF35FFFF34FFFF33FFFF32 FFFF30FFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF2BFFFF2AFFFF29FFFF29FFFF28FFFF28 FFFF27FFFF26FFFF26FFFF25FFFF25FFFF24FFFF23FFFF23FFFF22FFFF21FFFF21FFFF20FFFF1F FFFF1FFFFF1EFFFF1EFFFF1DFFFF1DFFFF1CFFFF1CFFFF1CFFFF1CFFFF1EFFFF1EFFFF20FFFF22 FFFF24FFFF26FFFF29FFFF2EFFFF32FFFF36FFFF3BFFFF3EFFFF44FFFF49F7F74C9595310B0B03 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0001000620001DB3001BE5000EE50003E50000E50000AD0043611AD2D14FFFFF5D FFFF59FFFF56FFFF53FFFF50FFFF4DFFFF4BFFFF49FFFF47FFFF44FFFF43FFFF41FFFF40FFFF3F FFFF3EFFFF3DFFFF3CFFFF3CFFFF3CFFFF3BFFFF3AFFFF39FFFF39FFFF38FFFF38FFFF38FFFF37 FFFF35FFFF34FFFF32FFFF30FFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF2AFFFF29FFFF29FFFF28 FFFF27FFFF27FFFF26FFFF26FFFF25FFFF24FFFF23FFFF23FFFF22FFFF21FFFF21FFFF20FFFF20 FFFF1FFFFF1EFFFF1EFFFF1DFFFF1DFFFF1DFFFF1BFFFF1BFFFF1BFFFF1AFFFF1AFFFF19FFFF19 FFFF19FFFF19FFFF1AFFFF1BFFFF1BFFFF1EFFFF20FFFF22FFFF25FFFF29FFFF2DFFFF32FFFF37 FFFF3BFFFF3FFFFF45FFFF4BB1B1371B1B09000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000103001894001DE60011E500 04E50000E50000D200364914E0E054FFFF5CFFFF59FFFF55FFFF52FFFF4FFFFF4CFFFF4AFFFF48 FFFF45FFFF42FFFF41FFFF3FFFFF3EFFFF3DFFFF3CFFFF3BFFFF3BFFFF3BFFFF3AFFFF39FFFF39 FFFF39FFFF39FFFF38FFFF37FFFF35FFFF34FFFF32FFFF30FFFF2FFFFF2EFFFF2DFFFF2BFFFF2A FFFF29FFFF28FFFF27FFFF26FFFF26FFFF25FFFF24FFFF23FFFF22FFFF22FFFF21FFFF21FFFF1F FFFF1FFFFF1EFFFF1DFFFF1DFFFF1DFFFF1CFFFF1CFFFF1CFFFF1BFFFF1AFFFF1AFFFF19FFFF18 FFFF18FFFF17FFFF17FFFF17FFFF17FFFF17FFFF17FFFF17FFFF17FFFF17FFFF1AFFFF1AFFFF1C FFFF1FFFFF22FFFF25FFFF29FFFF2EFFFF32FFFF37FEFE3CFEFE41FDFD47C9C93D1E1E09000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0003001267001FE20013E50006E50000E60000C5001E530BC4C44BFEFE5DFFFF59 FFFF55FFFF52FFFF4EFFFF4BFFFF49FFFF47FFFF43FFFF41FFFF40FFFF3EFFFF3DFFFF3CFFFF3B FFFF3AFFFF3AFFFF39FFFF38FFFF39FFFF39FFFF39FFFF38FFFF36FFFF35FFFF33FFFF31FFFF2F FFFF2FFFFF2DFFFF2CFFFF2AFFFF29FFFF28FFFF27FFFF26FFFF25FFFF24FFFF23FFFF22FFFF20 FFFF20FFFF1FFFFF1EFFFF1DFFFF1DFFFF1CFFFF1BFFFF1BFFFF1BFFFF1AFFFF19FFFF19FFFF18 FFFF18FFFF17FFFF17FFFF17FFFF17FFFF16FFFF16FFFF16FFFF17FFFF16FFFF16FFFF16FFFF16 FFFF16FFFF16FFFF16FFFF16FFFF1AFFFF1AFEFE1CF6F61CEFEF1EE2E21ED5D523B5B52D9E9E34 8D8D3A5A5A533333650F0F5A080805000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000061F0020CE0017E5000AE500 01E50000D9001D6A0BB4B444FFFF5EFFFF59FFFF55FFFF52FFFF4EFFFF4BFFFF49FFFF46FFFF43 FFFF40FFFF3FFFFF3EFFFF3CFFFF3BFFFF3AFFFF39FFFF39FFFF39FFFF39FFFF38FFFF38FFFF37 FFFF36FFFF35FFFF33FFFF31FFFF30FFFF2FFFFF2EFFFF2CFFFF2BFFFF2AFFFF28FFFF27FFFF25 FFFF24FFFF23FFFF21FFFF20FFFF1EFFFF1EFFFF1CFFFF1CFFFF1BFFFF1AFFFF1AFFFF19FFFF18 FFFF18FFFF17FFFF17FFFF17FFFF17FFFF17FFFF17FFFF17FFFF16FFFF16FFFF16FFFF16FFFF15 FFFF15FFFF15FFFF15FFFF14FFFF14FFFF14FEFE15F4F413ECEC12DDDD13DBDB14B0B01D969622 7C7C2C5B5B4B48485D2B2B7E2121901111B10707C80000D80000E80000DD000061000001FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF0000000109001687001CE5000EE50003E50000E500068602868C33FBFB5DFFFF5AFFFF56 FFFF52FFFF4FFFFF4BFFFF49FFFF46FFFF42FFFF40FFFF3FFFFF3EFFFF3CFFFF3BFFFF3AFFFF38 FFFF38FFFF38FFFF38FFFF37FFFF36FFFF35FFFF34FFFF33FFFF31FFFF30FFFF2FFFFF2EFFFF2D FFFF2CFFFF2AFFFF29FFFF27FFFF25FFFF25FFFF23FFFF21FFFF1FFFFF1EFFFF1DFFFF1CFFFF1B FFFF1AFFFF18FFFF18FFFF17FFFF16FFFF16FFFF17FFFF17FFFF17FFFF17FFFF16FFFF16FFFF16 FFFF16FFFF15FFFF15FFFF14FFFF14FFFF15FFFF14FEFE14FDFD15FCFC15FAFA15B9B90EA3A30D 74740F5454374242501F1F8419198D0B0BB70505CE0000E60000F00000F50000FD0000FF0000FF 0000FF0000FF0000F9000081000008FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000000000C480020D90013E50005E500 00E50000C3004E5C1DEFEE5BFFFF5BFFFF56FFFF53FFFF50FFFF4BFFFF49FFFF45FFFF42FFFF3F FFFF3EFFFF3DFFFF3AFFFF39FFFF39FFFF39FFFF38FFFF37FFFF36FFFF35FFFF34FFFF34FFFF33 FFFF31FFFF30FFFF30FFFF2FFFFF2EFFFF2DFFFF2BFFFF2AFFFF29FFFF27FFFF25FFFF24FFFF22 FFFF20FFFF1EFFFF1CFFFF1BFFFF1AFFFF18FFFF17FFFF16FFFF16FFFF17FFFF16FFFF16FFFF15 FFFF15FFFF15FFFF14FFFF14FFFF14FFFF15FFFF15FDFD15F6F613F1F112EBEB11B8B817B2B218 92921D68683541414E1313690000700000BB0000D00000FC0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FE00009C00000DFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF000000020A00199E001AE6000AE50001E50000DA00185809D2D250FEFE5CFFFF58FFFF54 FFFF50FFFF4DFFFF4AFFFF46FFFF43FFFF40FFFF3EFFFF3CFFFF3BFFFF39FFFF38FFFF38FFFF37 FFFF36FFFF35FFFF34FFFF33FFFF32FFFF30FFFF30FFFF30FFFF2FFFFF2FFFFF2DFFFF2DFFFF2B FFFF2AFFFF29FFFF28FFFF25FFFF24FFFF23FFFF20FFFF1FFFFF1CFFFF1BFFFF19FFFF18FFFF17 FFFF17FFFF17FFFF16FFFF15FFFF14FFFF14FFFF15FFFF15EEEE11E3E310D7D710BDBD18ABAB1D 8B8B287777354F4F5435356820207B0F0FB20D0DB90202D90000E70000F10000FC0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FB0000BD00000D000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000B3F001ED90012E50004E500 00E6000496027F8530FEFE5EFFFF59FFFF55FFFF52FFFF4EFFFF4AFFFF47FFFF43FFFF40FFFF3F FFFF3DFFFF3BFFFF39FFFF39FFFF38FFFF37FFFF35FFFF34FFFF33FFFF31FFFF30FFFF30FFFF30 FFFF30FFFF30FFFF2FFFFF2EFFFF2EFFFF2CFFFF2AFFFF2AFFFF28FFFF28FFFF25FFFF24FFFF22 FFFF20FFFF1EFFFF1CFFFF1AFFFF1AFFFF17FFFF17FEFE17F5F515F2F214EBEB14CDCD14B1B113 87871973731C4B4B4F37376B22228D1414A80C0CBA0202D70000E10000EF0000F80000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FE0000F80000F30000EB0000DD0000B200008A000025000000FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0001001BAA0019E6000BE50000E50000CF00386316F0EF5AFFFF5BFFFF57FFFF53 FFFF4FFFFF4BFFFF48FFFF44FFFF41FFFF3FFFFF3EFFFF3AFFFF39FFFF39FFFF38FFFF36FFFF35 FFFF33FFFF31FFFF30FFFF30FFFF30FFFF30FFFF30FFFF30FFFF30FFFF2EFFFF2DFFFF2EFFFF2D FFFF2BFFFF2AFFFF28FFFF28FFFF26FFFF24FFFF23FFFF21FDFD1EFBFB1BF9F919E7E718B7B716 8F8F137E7E1245454932325A0A0A7D05059E0303BD0101E50000F80000FC0000FD0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FD0000FB0000F80000E80000BB0000A700008000005400003C00000E 000006000006000003000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000006230021E60012E50004E500 00E500088E039CA03BFEFE5DFFFF58FFFF54FFFF51FFFF4CFFFF49FFFF45FFFF41FFFF3FFFFF3D FFFF3BFFFF39FFFF39FFFF38FFFF36FFFF34FFFF32FFFF30FFFF30FFFF30FFFF30FFFF30FFFF30 FFFF30FFFF30FFFF30FFFF2FFFFF2EFFFF2EFFFF2EFFFF2EF6F72BEEEF26E2E221DDDD1EB3B327 9E9E2B8A8A315C5C4B4343591B1B701212850A0AB70303DF0000EA0000F50000F80000FE0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FB0000ED0000E00000DA0000B50000A700008900006C00004800001D 00001200000A000007000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0103001580001BE5000CE50001E50000DE00376C15E0DE55FFFF5BFFFF56FFFF52 FFFF4EFFFF4AFFFF47FFFF43FFFF40FFFF3EFFFF3CFFFF3AFFFF39FFFF38FFFF37FFFF34FFFF33 FFFF30FFFF2FFFFF30FFFF30FFFF30FFFF30FFFF30FFFF30F7F82EEAEB2CDDE02BC8D025B7AE1F 9286178F7916946312744C332F307A2727861111B30808C60000D80000E80000F00000FD0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FB0000EF0000E60000DD0000BE00009D00007800006F000054000030 00002500001400000D000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000416001CB80015E50006E500 00E50001B8007A832FFBFB5DFFFF59FFFF54FFFF50FFFF4CFFFF49FFFF45FFFF42FFFF3FFFFF3D FFFF3BFFFF39FFFF39FFFF37FFFF35FFFF33FFFF30FFFF30FFFF30FFFF30FFFF30FFFF30FFFF30 FFFF30D6D5285D5F1C7D6D4488200E940F02C00801D10100EA0000EF00008C006E0200FE0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FD0000CC0000B000007B00006800004700002D 00001100000F000009000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0000000A3F001DD9000FE50002E50000E3000B6304CDCC4FFFFF5CFFFF56FFFF52 FFFF4EFFFF4BFFFF47FFFF43FFFF40FFFF3EFFFF3BFFFF3AFFFF39FFFF38FFFF36FFFF34FFFF32 FFFF30FFFF30FFFF30FFFF30FFFF30FEFE2FE3E32A7F82286D747AD9DCE8FDDBE7FE2634FF0000 FF0000FF0000FF0000FF0000B100511000F10000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FE0000F20000EE0000E50000CE0000B800009600008E000047000031 000006000003000002000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000300137A001BE5000AE500 01E50000D70052641FF7F65DFFFF5AFFFF55FFFF51FFFF4DFFFF4AFFFF46FFFF42FFFF3FFFFF3D FFFF3BFFFF39FFFF39FFFF37FFFF35FFFF33FFFF30FFFF30FFFF30FFFF30FFFF30FEFE30DDDD29 676948B0B1B6F5F6F8FFFFFFFFF6FAFF5B6AFF0000FF0000FF0000FF0000FF0000B800481300EC 0000FF0000FF0000FF0000FE0000F20000EA0000DA0000CF0000B100009600007C000056000044 00002300001A000011000004000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF00000003100019A70017E60006E50000E70005AC029D9E3CFEFE5CFFFF58FFFF54 FFFF4FFFFF4BFFFF48FFFF44FFFF40FFFF3FFFFF3CFFFF3AFFFF38FFFF39FFFF36FFFF34FFFF31 FFFF30FFFF30FFFF30FFFF30FEFE2FDDDD297D7D47D0D3E0FDFDFEFFFFFFFFFFFFFFFFFFFF949F FF0507FF0000FF0000FE0000FA0000D400292400D20000F10000B300009E000073000059000048 00002400001B000013000009000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000626001DCC0012E500 03E50000E8000E7105D8D852FFFF5BFFFF56FFFF52FFFF4DFFFF4AFFFF47FFFF42FFFF3FFFFF3D FFFF3BFFFF39FFFF39FFFF38FFFF35FFFF34FFFF31FFFF30FFFF30FFFF30FFFF30EEEF2C6C6C31 D8D7D9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8CBD6F21419BC0000AA00008600005700003D0000 0E0001000002000002000001000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF0000000C48001CDA000EE50001E50000D800296A0FFBFB5DFFFF5AFFFF55 FFFF51FFFF4CFFFF49FFFF45FFFF41FFFF3FFFFF3DFFFF3BFFFF39FFFF39FFFF37FFFF34FFFF32 FFFF30FFFF30FFFF30FFFF30FFFF3089801899211FFBB1B4FFFBFCFFFFFFFFFFFFF0F0F09DA1A9 49494D1B04040D0000090000000000000000000000010000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000001065001BE700 0BE50000E50000CB005F8224FDFD5DFFFF59FFFF54FFFF50FFFF4BFFFF49FFFF44FFFF41FFFF3E FFFF3CFFFF3AFFFF39FFFF38FFFF36FFFF33FFFF31FFFF30FFFF30FFFF30FFFF30E9E92C5E1704 ED0000FF181BFF929AFFF1F6EBEBEB6767670A0B0E000000000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF00010012790019E80008E50000E50000AE008A9734FFFF5CFFFF57 FFFF53FFFF4FFFFF4AFFFF47FFFF43FFFF40FFFF3EFFFF3BFFFF39FFFF39FFFF37FFFF36FFFF32 FFFF30FFFF30FFFF30FFFF30FFFF3086871AB80100FF0000FF0000FF0508EB5A6C5F5359030303 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00020019A300 16E70006E50000E60011AC06B3BF43FFFF5CFFFF57FFFF53FFFF4EFFFF4AFFFF46FFFF42FFFF3F FFFF3DFFFF3BFFFF39FFFF38FFFF37FFFF35FFFF31FFFF30FFFF30FFFF30FFFF30EAEB2D58370A FA0000FF0000FF0000FF00009701020A0101000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00010019AB0015E70004E50000E60012A007B5BC43FFFF5B FFFF56FFFF52FFFF4DFFFF4AFFFF46FFFF42FFFF3EFFFF3DFFFF3AFFFF39FFFF38FFFF36FFFF34 FFFF30FFFF30FFFF30FFFF30FFFF30D7D92A851504FE0000FF0000FF0000F80000420000010000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000200 20DA0013E50004E50000E70020910CD2CF4FFFFF5BFFFF56FFFF52FFFF4DFFFF4AFFFF46FFFF41 FFFF3FFFFF3DFFFF3AFFFF39FFFF37FFFF36FFFF33FFFF2FFFFF30FFFF30FFFF30FFFF30BAB722 AA0A02FF0000FF0000FF0000E30000170000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00020021E00012E50003E50000E70027940FDDD954 FFFF5BFFFF55FFFF52FFFF4DFFFF49FFFF45FFFF41FFFF3FFFFF3CFFFF3AFFFF39FFFF37FFFF35 FFFF33FFFF2FFFFF30FFFF30FFFF30FFFF30BAB222C0160EFF1212FF1212FF1212BB0D0D0D0101 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 00020021E00013E50003E50000E70027940FDDD954FFFF5BFFFF55FFFF51FFFF4DFFFF49FFFF45 FFFF41FFFF3FFFFF3BFFFF3AFFFF39FFFF37FFFF35FFFF33FFFF2FFFFF30FFFF30FFFF30FFFF30 BBBA2AC1AEA7FFDFDFFFDFDFFFDFDFBCA6A60D0C0CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00020021E00013E50003E50000E70027940F DDD954FFFF5BFFFF55FFFF51FFFF4DFFFF49FFFF45FFFF41FFFF3FFFFF3BFFFF3AFFFF38FFFF37 FFFF35FFFF33FFFF2FFFFF30FFFF30FFFF30FFFF30B8B828B3B3ACFFFFFFFFFFFFFFFFFFCACACA 111111000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF00020021E00013E50003E50000E70026940FDDD954FFFF5BFFFF55FFFF52FFFF4DFFFF49 FFFF45FFFF41FFFF3FFFFF3CFFFF3AFFFF39FFFF37FFFF35FFFF33FFFF2FFFFF30FFFF30FFFF30 FFFF30D1D22795958BFFFFFFFFFFFFFFFFFFF3F3F327272E000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0002001DC40014E60004E50000E700 179309C0C048FFFF5BFFFF56FFFF52FFFF4DFFFF4AFFFF46FFFF41FFFF3FFFFF3DFFFF3AFFFF39 FFFF37FFFF36FFFF33FFFF2FFFFF30FFFF30FFFF30FFFF30E7E72C5D5D38FCFCFCFFFFFFFFFFFF FCFCFC6A6A71010101FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF00020018A30016E70005E50000E60011AA07B3BE43FFFF5BFFFF56FFFF52FFFF4D FFFF4AFFFF46FFFF42FFFF3FFFFF3DFFFF3AFFFF39FFFF38FFFF36FFFF34FFFF30FFFF30FFFF30 FFFF30FFFF30FCFC2F737318D4D4D4FFFFFFFFFFFFFFFFFFCAC4C7281D1E000000000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00010017950017E70007E500 00E60008A2039EA73CFFFF5CFFFF57FFFF53FFFF4FFFFF4AFFFF46FFFF42FFFF3FFFFF3DFFFF3B FFFF39FFFF38FFFF36FFFF34FFFF31FFFF30FFFF30FFFF30FFFF30FFFF30DADA29606060F6F6F6 FFFFFFFFF2FBFE677CBC090D160000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF000000116A001BE9000AE50000E50000C60079912EFEFE5DFFFF58FFFF53 FFFF50FFFF4BFFFF47FFFF43FFFF3FFFFF3DFFFF3BFFFF39FFFF39FFFF37FFFF35FFFF32FFFF2F FFFF30FFFF30FFFF30FFFF30FFFF30767620B5B4B5FFC8D8FF3242FF0001FE0000C50000300000 080000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000001000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000E57001CE100 0DE50000E50000D20045791AFCFC5DFFFF59FFFF54FFFF50FFFF4CFFFF48FFFF44FFFF40FFFF3E FFFF3CFFFF3AFFFF38FFFF37FFFF36FFFF33FFFF30FFFF30FFFF30FFFF30FFFF30FFFF30DCDC29 6A592FD91E26FF0000FF0000FF0000FF0000E40000980505583C3C575757575757575757575757 5858572B2B57000057000057000057000057000057000057000057000057000057000057000057 000057000057000057000057000057000057000057000057000057000057000057000057000057 000057000057000057000057000057000057000057000057000057000057000057000057000057 000057000057000057000057000057000057000057000057000057000057000057000057000040 00001B000008000000000001FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF0000000938001DD30010E50001E50000E100176909F8F85DFFFF5A FFFF55FFFF52FFFF4DFFFF49FFFF45FFFF41FFFF3EFFFF3CFFFF3AFFFF39FFFF38FFFF37FFFF35 FFFF32FFFF30FFFF30FFFF30FFFF30FFFF30FEFE2FBBBB22771F06F50000FE0000FF0000FF0000 FF0000FB191BF0C1C4EFEFEFEFEFEFEFEFEFEFEFEFF0F0EF7474EF0000EF0000EF0000EF0000EF 0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF 0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF 0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF0000EF 0000EF0000EF0000EF0000EF0000EF0000EF0000E70000C900009F000055000015000004000000 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000041700 1CBD0015E50004E50000E800098B03B8B946FFFF5CFFFF57FFFF53FFFF4EFFFF4AFFFF47FFFF42 FFFF3FFFFF3DFFFF3BFFFF39FFFF38FFFF38FFFF36FFFF34FFFF32FFFF30FFFF30FFFF30FFFF30 FFFF30FFFF30C1C1254E1704DF0000FE0000FF0000FF0000FF3742FFEDF0FFFFFFFFFFFFFFFFFF FFFFFFFFFFFF7A7AFF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FE0000E9000098000045000008000001000000FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF02090017920019E60008E50000E60001C000777B2D FCFC5DFFFF59FFFF54FFFF50FFFF4CFFFF48FFFF43FFFF40FFFF3EFFFF3CFFFF3AFFFF39FFFF38 FFFF38FFFF36FFFF34FFFF31FFFF30FFFF30FFFF30FFFF30FFFF30FEFE30CCCC2769470D990801 E30000FE0001FF6A77FFFAFDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7A7AFF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FE 0000F30000CB00006300001A000001000001FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 0000000F5B001CE0000CE50001E50000E10029570FE9E95AFFFF5BFFFF56FFFF51FFFF4DFFFF4A FFFF45FFFF42FFFF3FFFFF3DFFFF3BFFFF3AFFFF38FFFF39FFFF37FFFF35FFFF34FFFF32FFFF30 FFFF30FFFF30FFFF30FFFF30FFFF30E5E62AA19C1B67380A901007C9798AE4E4E5F0F0F1F0F0F1 F0F0F1F0F0F1F1F1F17474F10000F10000F10000F10000F10000F10000F10000F10000F10000F1 0000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F1 0000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F1 0000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F10000F20000FC 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000F50000C5000065000014 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000729001ED20012E50004E50000E500 029001A7A940FFFF5DFFFF58FFFF53FFFF4FFFFF4BFFFF47FFFF43FFFF40FFFF3EFFFF3CFFFF3B FFFF39FFFF39FFFF39FFFF37FFFF36FFFF34FFFF34FFFF30FFFF30FFFF30FFFF30FFFF30FFFF2E FEFE2CF4F429C3C220908E1D72722A87874F87874E87874E87874D88884D64644C45454C45454B 45454B45454B45454B45454B45454A45454A45454A45454A45454A45454A45454A45454A45454A 45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A 45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A45454A 45454A45454A45454A45454A45454A30304B04046A0000990000CE0000FA0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000F90000B7000035000000000000FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF00000002090018980018E50009E50000E50000D000536B1FF1F15AFFFF5AFFFF54FFFF51 FFFF4DFFFF49FFFF46FFFF42FFFF3FFFFF3EFFFF3CFFFF3BFFFF39FFFF39FFFF39FFFF38FFFF36 FFFF35FFFF34FFFF31FFFF30FFFF30FFFF30FFFF2EFFFF2CFFFF2BFFFF29FEFE27FBFB26FAFA25 FAFA22FAFA21FAFA1EFAFA1CFAFA1BFAFA19FAFA18FAFA16FAFA17FAFA16FAFA16FAFA14FAFA14 FAFA14FAFA13FAFA12FAFA12FAFA12FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13 FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA13FAFA14FAFA14FAFA13 FAFA13FAFA14FAFA14FAFA13FAFA12FAFA12FAFA12FAFA12FAFA12FAFA11FAFA11FAFA11F8F812 EFEF11BBBB0D84840E55551D2929570808A20000DA0000FA0000FF0000FF0000FF0000FF0000FF 0000FE0000F500008B00001D000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0001000F58001EE6000FE500 02E50000E3001B770AC4C34AFFFF5CFFFF57FFFF53FFFF4FFFFF4BFFFF48FFFF44FFFF41FFFF3F FFFF3DFFFF3CFFFF3AFFFF39FFFF39FFFF39FFFF38FFFF37FFFF35FFFF34FFFF31FFFF30FFFF30 FFFF2EFFFF2CFFFF2BFFFF29FFFF27FFFF26FFFF24FFFF22FFFF20FFFF1EFFFF1DFFFF1BFFFF18 FFFF18FFFF17FFFF16FFFF16FFFF16FFFF14FFFF13FFFF14FFFF14FFFF13FFFF13FFFF13FFFF13 FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13FFFF13 FFFF13FFFF13FFFF13FFFF13FFFF14FFFF13FFFF13FFFF14FFFF13FFFF14FFFF13FFFF13FFFF13 FFFF13FFFF13FFFF13FFFF12FFFF12FFFF12FFFF12FFFF11FFFF12FFFF12F3F311DEDE0FA0A011 59592C1D1D690404BC0000ED0000FE0000FF0000FF0000FF0000FF0000FA0000BD00003F000004 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF00000001060021D80015E50007E50000E50000B0006B7D29FAFA5DFFFF5A FFFF55FFFF51FFFF4DFFFF4AFFFF47FFFF42FFFF40FFFF3EFFFF3DFFFF3BFFFF3AFFFF39FFFF39 FFFF39FFFF38FFFF37FFFF35FFFF33FFFF30FFFF30FFFF2FFFFF2DFFFF2BFFFF2AFFFF28FFFF27 FFFF25FFFF23FFFF21FFFF1FFFFF1DFFFF1CFFFF1AFFFF18FFFF18FFFF17FFFF17FFFF16FFFF16 FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16 FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16FFFF16 FFFF16FFFF16FFFF16FFFF15FFFF15FFFF15FFFF15FFFF14FFFF14FFFF14FFFF14FFFF14FFFF13 FFFF13FFFF13FFFF12FFFF12FFFF11FFFF11FFFF12F6F611CCCC0D83831818184E0101B60000FC 0000FF0000FF0000FF0000FF0000FF0000E0000061000004000001FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000100136E00 1CE4000EE50002E50000E000136A07C4C34AFFFF5CFFFF58FFFF54FFFF50FFFF4CFFFF49FFFF46 FFFF42FFFF40FFFF3EFFFF3DFFFF3BFFFF3AFFFF39FFFF39FFFF39FFFF39FFFF38FFFF36FFFF33 FFFF2FFFFF2FFFFF2FFFFF2DFFFF2BFFFF2AFFFF28FFFF26FFFF25FFFF22FFFF21FFFF1FFFFF1E FFFF1DFFFF1CFFFF1AFFFF1AFFFF19FFFF19FFFF19FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18 FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18FFFF18 FFFF18FFFF18FFFF18FFFF19FFFF19FFFF19FFFF19FFFF19FFFF19FFFF19FFFF19FFFF19FFFF19 FFFF19FFFF19FFFF18FFFF18FFFF17FFFF17FFFF16FFFF15FFFF15FFFF14FFFF14FFFF13FFFF13 FFFF12FFFF11FFFF11FFFF11E7E7107D7D0B1212560000D50000FD0000FF0000FF0000FF0000FF 0000FF00006E00000B000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000051D001DC20016E50007E50000E60000C200455E1A F4F45CFFFF5AFFFF56FFFF53FFFF4FFFFF4BFFFF49FFFF45FFFF42FFFF40FFFF3EFFFF3DFFFF3B FFFF3AFFFF39FFFF38FFFF39FFFF39FFFF38FFFF36FFFF32FFFF30FFFF2FFFFF2FFFFF2DFFFF2B FFFF2AFFFF28FFFF27FFFF25FFFF24FFFF22FFFF20FFFF1FFFFF1FFFFF1EFFFF1DFFFF1DFFFF1C FFFF1CFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1CFFFF1C FFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1CFFFF1B FFFF1BFFFF1BFFFF1CFFFF1CFFFF1CFFFF1BFFFF1BFFFF1BFFFF1BFFFF1BFFFF1AFFFF1AFFFF1A FFFF1AFFFF19FFFF18FFFF17FFFF17FFFF16FFFF15FFFF14FFFF13FFFF12FFFF12FFFF11FAFA11 C9C90E4A4A260B0B8D0000EB0000FF0000FF0000FF0000FF0000F7000094000010000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000 0002001372001DE3000FE50002E50000E300038201919237FBFB5CFFFF59FFFF55FFFF52FFFF4E FFFF4BFFFF48FFFF45FFFF42FFFF40FFFF3EFFFF3DFFFF3BFFFF3AFFFF3AFFFF38FFFF39FFFF39 FFFF38FFFF36FFFF33FFFF30FFFF30FFFF2FFFFF2DFFFF2BFFFF2AFFFF29FFFF27FFFF26FFFF25 FFFF24FFFF23FFFF22FFFF21FFFF20FFFF20FFFF20FFFF20FFFF1FFFFF1FFFFF1FFFFF1FFFFF1F FFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF20 FFFF20FFFF20FFFF20FFFF20FFFF20FFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1FFFFF1F FFFF1FFFFF1EFFFF1EFFFF1EFFFF1DFFFF1DFFFF1DFFFF1CFFFF1BFFFF1BFFFF1AFFFF19FFFF19 FFFF18FFFF17FFFF16FFFF14FFFF13FFFF13FFFF12FFFF11ECEC108C8C131C1C4D0000DF0000FC 0000FF0000FF0000FF0000F800009A00000A000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000621001DB80017E50009E50001E500 00E4001F5B0CC9C74DFFFF5DFFFF58FFFF54FFFF51FFFF4EFFFF4AFFFF48FFFF45FFFF42FFFF40 FFFF3EFFFF3EFFFF3CFFFF3BFFFF3AFFFF39FFFF38FFFF38FFFF39FFFF38FFFF35FFFF32FFFF30 FFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF2AF5F527959517868614FEFE26FFFF26FFFF25FFFF25 FFFF24FFFF24FFFF24FFFF24FFFF24FFFF24FFFF24FFFF24FDFD24C9C91CAAAA17AAAA17AAAA17 AAAA17AAAA17AAAA17AAAA17AAAA17BFBF1AFFFF24FFFF24FFFF24FFFF24FFFF24FFFF24FCFC24 ACAC187C7C10DBDB1EFFFF23FFFF23FFFF23FFFF23FFFF22FFFF22FFFF22FFFF22FFFF21FFFF21 FFFF20FFFF20FFFF1FFFFF1FFFFF1EFFFF1CFFFF1BFFFF1AFFFF1AFFFF19FFFF17FFFF16FFFF14 FFFF13FFFF13FFFF12FFFF11C5C50E3737200000BD0000FF0000FF0000FF0000FF0000FE00008E 000008000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF0000000002000E51001FE00012E50006E50000E50001BA0047651BE8E757FFFF5CFFFF57 FFFF54FFFF51FFFF4DFFFF4AFFFF49FFFF45FFFF42FFFF41FFFF3FFFFF3EFFFF3DFFFF3CFFFF3B FFFF3AFFFF39FFFF38FFFF38FFFF38FFFF37FFFF35FFFF32FFFF30FFFF30FFFF2EFFFF2EFFFF2D D6D624222206383809F8F829FAFA28FAFA28FAFA28FAFA28FAFA28FCFC28FFFF29FFFF28FFFF28 FFFF28FFFF28F3F32645450A06060106060106060106060106060106060106060106060164640F FFFF28FFFF28FFFF28FFFF28FFFF28FFFF28F2F22540400A121203CFCF20FFFF27FFFF27FFFF26 FFFF26FFFF26FFFF26FFFF26FFFF26FFFF25FFFF25FFFF24FFFF24FFFF23FFFF22FFFF21FFFF20 FFFF1FFFFF1EFFFF1DFFFF1BFFFF1AFFFF19FFFF18FFFF16FFFF15FFFF13FFFF12FEFE11E4E410 4646250505A30000FA0000FF0000FF0000FF0000F6000069000007FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000209001BA4001BE500 0FE50003E50000E500069402637026F1F15BFFFF5BFFFF57FFFF53FFFF50FFFF4DFFFF4BFFFF49 FFFF46FFFF43FFFF41FFFF40FFFF3FFFFF3EFFFF3DFFFF3CFFFF3BFFFF3AFFFF39FFFF38FFFF39 FFFF38FFFF37FFFF35FFFF33FFFF31FFFF31FFFF2FBABA220D0D021212033A3A0A3A3A0A3A3A0A 3A3A0A3A3A093A3A098E8E18FDFD2CFFFF2CFFFF2CFFFF2CFFFF2CF6F62B95951A828217828217 828217828217828217828217828217828216C0C021FFFF2CFFFF2CFFFF2CFFFF2CFFFF2CFFFF2B E8E8271818042F2F08E3E325FFFF2AFFFF2AFFFF29FFFF29FFFF28FFFF28FFFF29FFFF28FFFF28 FFFF27FFFF27FFFF27FFFF27FFFF25FFFF25FFFF24FFFF23FFFF22FFFF20FFFF1FFFFF1EFFFF1C FFFF1AFFFF19FFFF17FFFF15FFFF14FFFF13FFFF12E3E31169691A0505960000FA0000FF0000FF 0000FF0000E7000050000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF00000007260020D10018E5000BE50001E50000E000028C01848432 FCFC5EFFFF5BFFFF57FFFF53FFFF51FFFF4EFFFF4BFFFF49FFFF47FFFF44FFFF42FFFF40FFFF3F FFFF3EFFFF3EFFFF3CFFFF3BFFFF3BFFFF3AFFFF39FFFF38FFFF38FFFF39FFFF38FFFF37FFFF36 FFFF3495951E00000000000000000000000000000000000000000003030091911BFFFF30FFFF30 FFFF30FFFF30FFFF30FCFC2FF6F62DF6F62DF6F62DF6F62DF6F62DF6F62DF6F62DF6F62DF6F62D FDFD2FFFFF30FFFF30FFFF30FFFF30FFFF2FFFFF2FCECE250101004A4A0DEDED2AF6F62BF6F62B F6F62BF6F62AF6F62AFEFE2BFFFF2BFFFF2AFFFF29FFFF29FFFF29FFFF29FFFF28FFFF28FFFF28 FFFF27FFFF27FFFF25FFFF24FFFF22FFFF20FFFF1FFFFF1DFFFF1BFFFF19FFFF18FFFF16FFFF14 FFFF13FFFF12F2F21261610F0101A60000FF0000FF0000FF0000FF0000D8000015000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000 0D4A0020D90017E50008E50001E50000E400045D01959838F9F95CFFFF5BFFFF57FFFF54FFFF52 FFFF4FFFFF4CFFFF4BFFFF49FFFF46FFFF44FFFF43FFFF41FFFF3FFFFF3FFFFF3EFFFF3DFFFF3C FFFF3CFFFF3BFFFF3AFFFF3AFFFF39FFFF38FFFF38FFFF395F5F15111104BBBB29F8F836F8F836 F8F836F8F836F8F835F9F935FEFE36FFFF37FFFF37FFFF37FFFF37FFFF379A9A20000000000000 000000000000000000000000000000000000222207D7D72DFFFF35FFFF35FFFF35FFFF34FFFF34 FFFF3399991E0000000000000000000000000000000000000000001E1E05EDED2AFFFF2EFFFF2E FFFF2EFFFF2DFFFF2CFFFF2CFFFF2CFFFF2BFFFF2BFFFF2AFFFF29FFFF29FFFF28FFFF26FFFF24 FFFF23FFFF21FFFF1EFFFF1CFFFF1AFFFF19FFFF17FFFF14FFFF14FFFF13FFFF143C3C1F0101B8 0000FE0000FF0000FF0000FF0000BB00000B000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF020C001579001FE10013E50007E50000E500 00DA00146F08868D33F0EF5AFFFF5CFFFF58FFFF55FFFF53FFFF50FFFF4DFFFF4BFFFF4AFFFF48 FFFF46FFFF44FFFF42FFFF41FFFF40FFFF3FFFFF3FFFFF3EFFFF3DFFFF3CFFFF3CFFFF3BFFFF3C FFFF3BFEFE3A2E2E0A04040121210729290929290929290929290929290940400EEBEB35FFFF3A FFFF3AFFFF3AFFFF3AFFFF3A9494223E3E0F3E3E0F3E3E0F3E3E0F3E3E0F3E3E0F3E3E0F3E3E0E 676717EFEF36FFFF39FFFF39FFFF39FFFF39FFFF39FEFE3868681600000031310B3E3E0E3E3E0D 3E3E0C3E3E0C3E3E0C6D6D14F6F62DFFFF2EFFFF2EFFFF2EFFFF2EFFFF2EFFFF2EFFFF2EFFFF2E FFFF2DFFFF2DFFFF2CFFFF2BFFFF2AFFFF29FFFF27FFFF26FFFF24FFFF21FFFF1FFFFF1DFFFF1A FFFF19FFFF17FFFF15FFFF14FFFF13DADA1140402F0000D20000FF0000FF0000FF0000FA00006A 000007000002FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF010700031200178A001DE50012E50006E50000E50000D700098503636A26F2F25DFEFE5C FFFF59FFFF56FFFF53FFFF51FFFF4FFFFF4DFFFF4BFFFF49FFFF48FFFF46FFFF45FFFF44FFFF42 FFFF42FFFF41FFFF40FFFF3FFFFF3FFFFF3EFFFF3EFFFF3EEAEA38111104090902121205121205 1212051212041212051212053C3C0FFDFD3CFFFF3DFFFF3DFFFF3DFFFF3DFEFE3DF8F83CF6F63B F6F63BF6F63BF6F63BF6F63BF6F63BF6F63BF6F63AFBFB3BFFFF3CFFFF3CFFFF3CFFFF3CFFFF3B FFFF3BF3F33742420F020200DDDD31FFFF38FFFF38FFFF36FFFF34FFFF32FFFF31FFFF31FFFF31 FFFF30FFFF30FFFF2FFFFF2FFFFF2FFFFF2FFFFF2FFFFF2FFFFF2FFFFF2EFFFF2EFFFF2DFFFF2B FFFF2AFFFF28FFFF27FFFF24FFFF22FFFF1FFFFF1DFFFF1BFFFF19FFFF17FFFF14FFFF14FFFF14 BFBF101C1C4E0000FA0000FF0000FF0000FF0000D2000028000003000000FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000311001EB5001EE500 12E50006E50001E50000E300018F004F601EDBDA52FFFF5DFFFF5AFFFF58FFFF54FFFF53FFFF51 FFFF4FFFFF4DFFFF4BFFFF4AFFFF49FFFF48FFFF47FFFF46FFFF45FFFF44FFFF43FFFF43FFFF42 FFFF42FFFF42BDBD300A0A02898923FFFF41FFFF41FFFF41FFFF41FFFF41FFFF41FFFF41FFFF41 FFFF41FFFF41FFFF41FFFF41E2E23A5D5D17444411444411444411444411444411444411444411 444411B4B42DFFFF40FFFF40FFFF40FFFF3FFFFF3FFFFF3EDBDB34262609202007F3F337FFFF3A FFFF39FFFF39FFFF38FFFF37FFFF34FFFF33FFFF33FFFF32FFFF31FFFF31FFFF31FFFF31FFFF31 FFFF30FFFF30FFFF30FFFF30FFFF30FFFF2FFFFF2EFFFF2DFFFF2BFFFF29FFFF27FFFF25FFFF22 FFFF20FFFF1DFFFF1AFFFF19FFFF17FFFF15FFFF13FBFB148E8E0D00008D0000FB0000FF0000FF 0000FC00008B000004000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF000000000000051D001BA5001EE40013E50008E50001E50000E30002B001 245D0DA3A23DF1F15BFFFF5DFFFF59FFFF57FFFF54FFFF53FFFF51FFFF50FFFF4EFFFF4CFFFF4B FFFF4BFFFF4AFFFF49FFFF48FFFF48FFFF47FFFF46FFFF46FFFF46929227070702B8B832FFFF46 FFFF46FFFF46FFFF46FFFF46FFFF46FFFF46FFFF46FFFF46FFFF46FFFF46FFFF46CDCD382D2D0C 212109212109212109212109212109212109212109212109C8C836FFFF45FFFF45FFFF44FFFF44 FFFF43FFFF42C1C1310C0C034E4E13F8F83CFFFF3CFFFF3AFFFF39FFFF39FFFF38FFFF39FFFF37 FFFF33FFFF32FFFF33FFFF32FFFF32FFFF32FFFF32FFFF32FFFF32FFFF32FFFF32FFFF31FFFF30 FFFF2FFFFF2FFFFF2EFFFF2CFFFF29FFFF28FFFF25FFFF22FFFF20FFFF1DFFFF1AFFFF19FFFF17 FFFF14FFFF14F6F6144A4A210101CC0000FF0000FF0000FF0000E4000030000000FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000 0623001CA6001EE30014E5000AE50002E50000E60000CE000F8206596622CBCB4DFBFB5DFFFF5B FFFF59FFFF57FFFF55FFFF53FFFF52FFFF51FFFF50FFFF4EFFFF4DFFFF4DFFFF4CFFFF4CFFFF4B FFFF4BFFFF4BFFFF4BDCDC41BDBD38F0F046FFFF4AFFFF4AFFFF4AFFFF4AFFFF4AFFFF4AFFFF4A FFFF4AFFFF4AFFFF4AFFFF4AFFFF4AF4F447D7D73FD7D73FD7D73FD7D73FD7D73FD7D73FD7D73F D7D73FD7D73FF8F848FFFF49FFFF49FFFF48FFFF48FFFF47FFFF46EBEB3FBABA31D4D436FEFE40 FFFF3EFFFF3DFFFF3BFFFF39FFFF39FFFF39FFFF39FFFF37FFFF33FFFF33FFFF33FFFF33FFFF33 FFFF33FFFF33FFFF33FFFF33FFFF32FFFF33FFFF32FFFF31FFFF30FFFF2FFFFF2EFFFF2CFFFF2A FFFF27FFFF25FFFF22FFFF1FFFFF1CFFFF1AFFFF18FFFF16FFFF14FEFE15CBCB101D1D5C0000F0 0000FF0000FF0000FD000098000001000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000010900188F0021E40017E5000DE500 03E50000E50000E40000B9001E5B0B7B7D2FEBEB59FFFF5DFFFF5BFFFF5AFFFF58FFFF56FFFF55 FFFF53FFFF52FFFF52FFFF51FFFF50FFFF50FFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4F FFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4F FFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4FFFFF4EFFFF4EFFFF4DFFFF4C FFFF4CFFFF4BFFFF49FFFF48FFFF46FFFF44FFFF42FFFF41FFFF3FFFFF3CFFFF3BFFFF3AFFFF39 FFFF39FFFF38FFFF38FFFF35FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF35 FFFF34FFFF33FFFF32FFFF30FFFF2FFFFF2EFFFF2CFFFF29FFFF27FFFF25FFFF21FFFF1FFFFF1B FFFF19FFFF17FFFF16FFFF14FDFD157D7D190303B40000FF0000FF0000FF0000FC000026000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF00000001050015770020D3001AE50011E50008E50002E50000E50000E20001A800 1754087B872FC9C84BF3F25AFFFF5EFFFF5CFFFF5AFFFF59FFFF57FFFF56FFFF56FFFF55FFFF55 FFFF55FFFF54FFFF54FFFF54FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53 FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF53FFFF54 FFFF54FFFF54FFFF53FFFF53FFFF53FFFF52FFFF51FFFF50FFFF4FFFFF4EFFFF4CFFFF4AFFFF48 FFFF46FFFF43FFFF41FFFF3FFFFF3DFFFF3BFFFF39FFFF39FFFF39FFFF39FFFF38FFFF34FFFF33 FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF34FFFF34FFFF35FFFF34FFFF32FFFF30FFFF2F FFFF2EFFFF2BFFFF29FFFF27FFFF24FFFF20FFFF1EFFFF1BFFFF18FFFF17FFFF16FFFF14D7D710 2A2A4B0000F80000FF0000FF0000FF000099000005FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000051A000D4700 20BF001EE70016E5000DE50005E50001E50000E60000D90001B0001A7B0A4D741D989E3AD2D050 E8E758FBFB5DFFFF5DFFFF5CFFFF5BFFFF5AFFFF5AFFFF59FFFF59FFFF58FFFF58FFFF59FFFF58 FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58 FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF58FFFF57FFFF56FFFF56 FFFF55FFFF54FFFF53FFFF51FFFF4FFFFF4DFFFF4BFFFF48FFFF46FFFF43FFFF41FFFF3FFFFF3D FFFF3BFFFF39FFFF39FFFF39FFFF39FFFF38FFFF34FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33 FFFF33FFFF34FFFF35FFFF34FFFF34FFFF32FFFF30FFFF2FFFFF2DFFFF2AFFFF28FFFF26FFFF22 FFFF1FFFFF1CFFFF1AFFFF18FFFF17FFFF14FAFA147A7A160101C50000FF0000FF0000FF0000D6 000022000001FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF062200000300051F00188D0022DE001BE40012E5000BE500 04E50001E50000E60000E30000CF00069B021A810A3C6C17686929929339CDCD4EF5F55EF5F55E F5F55EF5F55EF5F55DF5F55DF5F55DF5F55DF5F55DF5F55DF5F55DF5F55DF5F55CF5F55CF5F55C F5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55CF5F55C F5F55CF5F55CF5F55CF5F55CF5F55CF5F55BF5F55AF5F558F5F557F5F556F5F554F5F553F5F550 F5F54EF5F54CF5F549F5F546F5F543F5F541F5F53EF5F53CF5F53BF5F539F5F539F5F538F8F839 FDFD38FFFF35FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF34FFFF35FFFF33 FFFF32FFFF30FFFF2EFFFF2DFFFF2AFFFF28FFFF24FFFF21FFFF1EFFFF1AFFFF19FFFF17FFFF16 FFFF15D0D0110606650000FA0000FF0000FF0000F6000056000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0003000B3F001EB00021E2001AE50014E5000DE50006E50002E50000E50000E500 00E50000E50000E20000AA00008000006E00006E00006E00006E00006E00006E00006E00006E00 006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00 006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00 006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00006E00136F13 6674667474747474747474747474746B6B696E6C4B787322B1AE26F1F131FEFE32FFFF33FFFF33 FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF32FFFF31FFFF2FFFFF2EFFFF2BFFFF29 FFFF26FFFF23FFFF20FFFF1CFFFF1AFFFF18FFFF17FFFF15F7F71456561B0000E20000FF0000FF 0000FF000098000008FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000031000115F00 1DB10021DF001CE60015E50010E5000AE50006E50003E50001E50000E50000E60000E60000E700 00E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E700 00E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E700 00E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E70000E700 00E70000E70000E70000E70000E70000E70027E927DEFCDEFFFFFFFFFFFFFFFFFFFFFFFFFCFCFC EFD0DAD81F33990A026B350B9E991FEFF030FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33 FFFF33FFFF32FFFF31FFFF2FFFFF2FFFFF2CFFFF29FFFF27FFFF24FFFF21FFFF1EFFFF1BFFFF19 FFFF17FFFF15FEFE14ACAC0F0808960000FF0000FF0000FF0000D200001F000000FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000000000419000F56001DAF0022DC001EE50019E500 14E50010E5000CE50008E50006E50004E50003E50001E50001E50001E50000E50000E50000E500 00E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E500 00E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E500 00E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E500 27E827DDFBDDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBDC5FF1116FF0000E10000940A026E5511 E3E32DFEFE33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF33FFFF32FFFF2FFFFF2FFFFF2E FFFF2AFFFF28FFFF25FFFF22FFFF1FFFFF1CFFFF19FFFF17FFFF16FFFF15F3F3131E1E590000F4 0000FF0000FF0000EC000047000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF0001000000000107000A3500167C0022C50024E30020E5001CE50018E50016E50013E500 10E5000FE5000CE5000BE5000AE50009E50008E50007E50007E50007E50007E50007E50007E500 07E50007E50007E50006E50006E50006E50006E50006E50006E50006E50006E50006E50006E500 06E50006E50006E50006E50006E50006E50006E50005E50005E50004E50003E50003E50001E500 01E50000E50000E50000E50000E50000E50000E50027E827DDFBDDFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFF8D97FF0306FF0000FF0000FE0000C8000064400CDEDF2CFFFF32FFFF32FFFF32FFFF32 FFFF32FFFF32FFFF32FFFF32FFFF30FFFF2FFFFF2EFFFF2BFFFF29FFFF26FFFF24FFFF20FFFF1D FFFF1AFFFF18FFFF16FFFF15FDFD145A5A310000DE0000FF0000FF0000FF000071000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000300010400 020B000B3800187C001C9E0022C80020C8001EC8001CC8001AC80018C80017C80017C80016C800 15C80014C80014C80014C80014C80014C80014C80014C80014C80014C80014C80014C80014C800 14C80014C80014C80014C80014C80014C80014C80014C80014C80014C80014C80013C80013C800 12C80012C80011C80011C8000FC8000EC8000DC8000AC80008C80005C80003C80001C80000C800 00C80022CB22C0DAC0DDDDDDDDDDDDDDDDDDDDDDDDDCD6D7E94E53FE0000FF0000FF0000FF0000 FF0000D601006A440DE1E22BFFFF30FFFF30FFFF30FFFF31FFFF32FFFF32FFFF32FFFF2FFFFF30 FFFF2FFFFF2CFFFF29FFFF28FFFF25FFFF21FFFF1FFFFF1BFFFF19FFFF17FFFF16FFFF1595951E 0404BD0000FF0000FF0000FF0000B5000002FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000010400030E00062100062100 062100052100052100052100052100052100042100042100042100042100042100042100042100 042100042100042100042100042100042100042100042100042100042100042100042100042100 042100042100042100042100042100042100042100042100042100042100042100032100032100 032100032100022100022100012100002100002100002100062106202420252525252525252525 2525252823233D0B0B930000EA0000FE0000FF0000FF0000FC141FAC6264717224FBFB30FFFF31 FFFF31FFFF31FFFF32FFFF31FFFF32FFFF30FFFF2FFFFF2FFFFF2DFFFF2AFFFF28FFFF26FFFF22 FFFF1FFFFF1CFFFF19FFFF17FFFF17FFFF15B5B51312129A0000FF0000FF0000FF0000E2000002 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF040000060000410000E50000 FE0000FF1B30FFB6C7F9F4F7757575BBBB24FFFF31FFFF31FFFF31FFFF31FFFF32FFFF32FFFF30 FFFF2FFFFF2FFFFF2EFFFF2AFFFF29FFFF26FFFF23FFFF20FFFF1DFFFF19FFFF17FFFF17FFFF14 DADA0E2525760000FD0000FF0000FF0000EF000002000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000003D0202DA4857FFE3F0FFFFFFFFFFFFEDEDEC565620 EFEF2EFFFF31FFFF31FFFF31FFFF32FFFF32FFFF30FFFF30FFFF2FFFFF2EFFFF2BFFFF29FFFF27 FFFF24FFFF20FFFF1DFFFF1AFFFF18FFFF17FFFF14EBEB114242510000F50000FF0000FF0000F7 000046000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 050101524E53F6F5F8FFFFFFFFFFFFFEFEFE83837AC8C827FFFF31FFFF31FFFF30FFFF32FFFF32 FFFF30FFFF30FFFF2FFFFF2EFFFF2CFFFF29FFFF28FFFF25FFFF21FFFF1EFFFF1AFFFF18FFFF17 FFFF14F0F0124D4D4C0000F40000FF0000FF0000F8000048000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000101012C9C9CEFFFFFFFFFFFFFFFFFF C2C2C1949426FFFF32FFFF31FFFF30FFFF31FFFF32FFFF31FFFF2FFFFF2FFFFF2EFFFF2DFFFF2A FFFF28FFFF25FFFF21FFFF1FFFFF1AFFFF18FFFF17FFFF14FAFA1467672B0000EB0000FF0000FF 0000FD000074000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF00000186868AFFFFFFFFFFFFFFFFFFE9E9EB7B7B2CF7F72FFFFF31FFFF31FFFF31 FFFF32FFFF31FFFF2FFFFF2FFFFF2EFFFF2DFFFF2AFFFF28FFFF25FFFF21FFFF1FFFFF1AFFFF18 FFFF17FFFF13FFFF157A7A270000E90000FF0000FF0000FF000085000000FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000484949F8F9F9FFFFFF FFFFFFF5F5F698985AEEEE2CFFFF31FFFF31FFFF31FFFF32FFFF31FFFF2FFFFF2FFFFF2EFFFF2D FFFF2AFFFF29FFFF25FFFF21FFFF1FFFFF1BFFFF19FFFF17FFFF13FFFF157A7A270000E90000FF 0000FF0000FF000085000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF000000453030F8AEAEFFB1B1FFB1B1F5ABAB9A8344EEEE2CFFFF31FFFF31 FFFF31FFFF32FFFF31FFFF2FFFFF30FFFF2FFFFF2DFFFF2AFFFF28FFFF25FFFF22FFFF1FFFFF1B FFFF19FFFF17FFFF13FFFF157A7A270000E90000FF0000FF0000FF000085000000FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000440202F80808 FF0808FF0808F507079A5011EEF02EFFFF31FFFF31FFFF31FFFF32FFFF31FFFF30FFFF30FFFF2F FFFF2DFFFF2AFFFF29FFFF25FFFF21FFFF1FFFFF1AFFFF19FFFF17FFFF13FFFF157A7A270000E9 0000FF0000FF0000FF000085000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF010000890000FE0000FF0000FF0000ED00007F5B11F5F52FFFFF31 FFFF31FFFF31FFFF32FFFF32FFFF30FFFF30FFFF2FFFFF2DFFFF2AFFFF28FFFF25FFFF21FFFF1F FFFF1AFFFF18FFFF17FFFF14F9F9146666280000EB0000FF0000FF0000FD000075000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000110000C50000 FF0000FF0000FF0000CE01008C7D18FEFE31FFFF31FFFF31FFFF31FFFF32FFFF32FFFF30FFFF30 FFFF2FFFFF2DFFFF2AFFFF28FFFF25FFFF21FFFF1EFFFF1AFFFF18FFFF17FFFF14F0F0124E4E4D 0000F40000FF0000FF0000F8000048000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF0000000102024C0607F60101FF0000FF0000FF00009C0A02BAB923FFFF31 FFFF31FFFF31FFFF32FFFF32FFFF32FFFF30FFFF2FFFFF2EFFFF2CFFFF2AFFFF28FFFF24FFFF21 FFFF1EFFFF1AFFFF18FFFF17FFFF14EBEB114242520000F60000FF0000FF0000F7000044000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000000003E4042D5BDC6 FF4459FF0202FF0000FB0000512F09E7E82EFFFF31FFFF31FFFF31FFFF32FFFF32FFFF31FFFF30 FFFF2FFFFF2EFFFF2CFFFF29FFFF27FFFF24FFFF20FFFF1DFFFF1AFFFF17FFFF17FFFF14DCDC0E 2525760000FD0000FF0000FF0000EF000003000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF0000000000010B0C11494A4EDDDDDDFEFEFEFFF0F4FF6F74FC1113940100999A1FFDFD31 FFFF31FFFF31FFFF32FFFF33FFFF32FFFF31FFFF30FFFF2FFFFF2EFFFF2BFFFF29FFFF27FFFF23 FFFF20FFFF1CFFFF19FFFF17FFFF16FFFF15B3B3121111990000FF0000FF0000FF0000E3000002 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF0000000000000000000000000900001100001A000031000061393EA2A5AEEAEAEDFEFEFE FFFFFFFFFFFFFFF5F7CA7E7F5D3F0FF7F730FFFF31FFFF30FFFF32FFFF32FFFF33FFFF32FFFF31 FFFF30FFFF2FFFFF2EFFFF2AFFFF28FFFF25FFFF22FFFF1FFFFF1BFFFF19FFFF17FFFF16FFFF15 94941E0404BE0000FF0000FF0000FF0000B3000002FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000000000000000100000100000100001E000040004B1D00870000AC0000 CD0000EF0000F50000FB5F6BFFF8FAFFFFFFFFFFFFFFFFFFFFFFFFF2F2F2777860C7C925FFFF31 FFFF31FFFF31FFFF32FFFF33FFFF33FFFF32FFFF30FFFF2FFFFF2FFFFF2CFFFF29FFFF28FFFF25 FFFF21FFFF1EFFFF1AFFFF18FFFF16FFFF15FDFD145B5B310000DD0000FF0000FF0000FF000073 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000000000000010700021200031900032600054400065900056B00049300 02B70001DE0000E20000E6007E7800FE0000FF0000FF0000FF0000FF0000FF2838FFDFE8FFFFFF FFFFFFFEFEFEE5E7EE7C7D6EBFBF29FEFE32FFFF30FFFF30FFFF31FFFF32FFFF32FFFF32FFFF31 FFFF2FFFFF2FFFFF2EFFFF2BFFFF28FFFF26FFFF23FFFF1FFFFF1CFFFF1AFFFF17FFFF16FFFF15 F3F3131E1E590000F40000FF0000FF0000EB000047000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000000000000010700021100031B00042000094B000A59000C71000D8600 0EA4000FC4000CCD0009D70006E00003E80001E70000E60000E50000E50000E700529F00FD0200 FF0000FF0000FF0000FF0000FF1017FFB1C3FFFFFFF7F8FAB7B8C4636450BBBB2EFBFB33FFFF31 FFFF31FFFF31FFFF32FFFF32FFFF31FFFF31FFFF30FFFF2FFFFF2EFFFF2DFFFF2AFFFF28FFFF25 FFFF22FFFF1EFFFF1BFFFF19FFFF17FFFF16FEFE14AAAA0F0707950000FE0000FF0000FF0000D2 00001F000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 000000000000000000000000000000000100000200000300000400062E000A54000F7C00109100 12AA0014C20012CD0011D9000FDE000EE7000AE70007E60004E50002E50000E50000E50000E500 00E50000E50000E50000E50000E7004BA500FC0200FF0000FF0000FF0000FE0000FD0003FC7396 D7D7E46A6F7E7A7F36DADA30FEFE36FFFF33FFFF31FFFF31FFFF31FFFF32FFFF32FFFF31FFFF30 FFFF30FFFF2FFFFF2DFFFF2BFFFF29FFFF26FFFF24FFFF21FFFF1DFFFF1AFFFF18FFFF17FFFF15 F8F81459591B0000E20000FF0000FF0000FF000098000007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000000000000010400020C00020E000210000632000744000B68000E7D00 12A70015CA0016E80013E70011E6000EE5000CE50009E50007E50005E50003E50001E50000E500 00E50000E50000E50000E50000E50000E50000E50000E60000E60000E70000E20000DC001BBC00 E40200C20802BD0902980F04811D067F431067571474761CD6D630FFFF39FFFF38FFFF35FFFF32 FFFF31FFFF31FFFF31FFFF31FFFF31FFFF2FFFFF30FFFF2FFFFF2EFFFF2BFFFF29FFFF27FFFF24 FFFF21FFFF1EFFFF1BFFFF19FFFF18FFFF16FFFF15CECE110505630000FA0000FF0000FF0000F7 000057000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000000000000000000021200031700042000063400094F000B64000D7A00 109D0010AD0013CF0012D80010DD000FE6000DE7000AE60008E50006E50004E50003E50001E500 01E50001E50000E50000E50000E50000E50000E50000E60000E70000E80000E40000D70000CD00 00C3000BB30413AA0725960D39931351921B708E248F7B27B8AE35BAB233CCCF39DFE23DEDEF3D F5F63CFFFF3BFFFF39FFFF39FFFF38FFFF33FFFF33FFFF32FFFF32FFFF31FFFF31FFFF30FFFF30 FFFF2FFFFF2EFFFF2CFFFF2AFFFF28FFFF25FFFF22FFFF1FFFFF1DFFFF1AFFFF18FFFF17FFFF16 FAFA147979160101C70000FF0000FF0000FF0000D6000022000001FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000000000000000000000000010600020C000212000420000845000C63000E7B00 11A20011AF0012C60011CF0010D80010E4000EE8000BE70009E60006E50005E50003E50002E500 01E50001E50000E50000E50000E50000E50000E50000E50000E50000E60000E50000E00000DE00 00DB0004C3020BA604128507217C0C478B1A6D97288CA132A7B63BB8C240DAD74BE6E34EF1EF4F FCFB50FFFF4FFFFF4BFFFF48FFFF45FFFF41FFFF3EFFFF3DFFFF3AFFFF39FFFF39FFFF37FFFF33 FFFF33FFFF31FFFF31FFFF31FFFF30FFFF30FFFF2FFFFF2EFFFF2CFFFF2AFFFF28FFFF26FFFF23 FFFF20FFFF1EFFFF1BFFFF19FFFF17FFFF17FFFF15D6D6102A2A4C0000F70000FF0000FF0000FF 000097000005FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000200010500031500093B000D5B00107700 139A0015BB0017DC0015DF0012E20010E4000DE5000BE50008E50006E50004E50003E50002E500 01E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E50000E30000E100 00DE0001C60003A801068802097903427F18588121808330989D39BDC046E6E754F9F95AFBFB5A FDFD59FFFF58FFFF57FFFF55FFFF54FFFF52FFFF4FFFFF4EFFFF4BFFFF48FFFF45FFFF43FFFF3F FFFF3DFFFF3BFFFF3AFFFF39FFFF38FFFF34FFFF33FFFF33FFFF31FFFF31FFFF2FFFFF2FFFFF2F FFFF2EFFFF2CFFFF2AFFFF29FFFF26FFFF24FFFF21FFFF1EFFFF1CFFFF19FFFF17FFFF17FFFF16 FDFD158181180303B20000FF0000FF0000FF0000FF000027000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 031000147E0020D6001DDD0019E00016E30012E5000EE5000BE50008E50005E50003E50002E500 01E50001E50000E50000E50000E50000E50000E50000E50000E70000E80000E90000E00000D400 00C60003BE010EAF0519A20923970D3F8F17508B1E727F2B929837B8BC45DEDE53EAEA59F4F45A F8F85AFFFF5BFFFF5AFFFF59FFFF58FFFF57FFFF56FFFF55FFFF54FFFF53FFFF51FFFF50FFFF4E FFFF4CFFFF4AFFFF47FFFF45FFFF43FFFF40FFFF3EFFFF3CFFFF3AFFFF39FFFF38FFFF37FFFF33 FFFF33FFFF32FFFF30FFFF30FFFF2FFFFF2EFFFF2DFFFF2CFFFF2AFFFF29FFFF26FFFF24FFFF21 FFFF1FFFFF1CFFFF1AFFFF18FFFF16FFFF15FEFE14CBCB101B1B5C0000F00000FF0000FF0000FD 000097000001000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000003000D720019DF0014E5000FE5000AE50006E500 04E50002E50001E50000E50000E50000E50000E50000E50000E60000E60000E70000E10000DA00 00D20000CD000EAD0518970921850C338B1355941F809D3090A635AEBB40C8CC49D8D451E8E555 F0EE57FFFE5CFFFF5BFFFF5AFFFF59FFFF58FFFF57FFFF56FFFF56FFFF55FFFF55FFFF54FFFF53 FFFF52FFFF51FFFF50FFFF4FFFFF4DFFFF4CFFFF4AFFFF48FFFF46FFFF44FFFF42FFFF40FFFF3E FFFF3CFFFF3AFFFF39FFFF39FFFF37FFFF34FFFF33FFFF32FFFF31FFFF2FFFFF2FFFFF2EFFFF2D FFFF2BFFFF2AFFFF28FFFF26FFFF24FFFF21FFFF1FFFFF1CFFFF1AFFFF18FFFF17FFFF15FFFF15 F4F4144A4A230202CB0000FF0000FF0000FF0000E4000031000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000300 0759000FDE0009E50005E50002E50000E50000E50000E50000E50000E50000E50000E50000E600 00E70000E70000BB00009500006B001F740B49811B778F2C8D9834B5BD43D3D54DEBE956F0EF57 F7F759FEFE5CFFFF5BFFFF5AFFFF59FFFF58FFFF58FFFF57FFFF56FFFF56FFFF55FFFF54FFFF54 FFFF53FFFF53FFFF52FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4BFFFF49FFFF48 FFFF46FFFF45FFFF43FFFF41FFFF3FFFFF3EFFFF3CFFFF3AFFFF3AFFFF39FFFF38FFFF34FFFF32 FFFF32FFFF30FFFF2FFFFF2EFFFF2EFFFF2CFFFF2BFFFF29FFFF28FFFF26FFFF24FFFF21FFFF1F FFFF1CFFFF1AFFFF19FFFF17FFFF15FFFF14FBFB1490900D01018C0000FB0000FF0000FF0000FC 00008D000004000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000200023E0006CF0002E60000E60000E70000E30000DA00 00D20000CC0007B6030CAB041793092F8A1148841A617B24726F2CA5A33ED0CF4DFBFB5DFCFC5D FDFD5CFEFE5BFFFF5AFFFF59FFFF58FFFF58FFFF57FFFF57FFFF56FFFF55FFFF55FFFF54FFFF53 FFFF52FFFF52FFFF51FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4CFFFF4CFFFF4B FFFF4AFFFF49FFFF48FFFF46FFFF46FFFF45FFFF43FFFF42FFFF41FFFF3FFFFF3DFFFF3CFFFF3B FFFF3AFFFF39FFFF38FFFF36FFFF33FFFF32FFFF31FFFF2FFFFF2EFFFF2DFFFF2CFFFF2AFFFF29 FFFF28FFFF26FFFF25FFFF23FFFF20FFFF1EFFFF1CFFFF1AFFFF18FFFF16FFFF14FFFF14FFFF15 BEBE0F1B1B4C0000FE0000FF0000FF0000FF0000D2000027000001FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000002100 00AA0000C6000CB20514A80824940E2F92124C931D6794277D932FA2B03CB6BF43D9D751E4E255 EFED57F9F85AFFFF5CFFFF5AFFFF59FFFF58FFFF57FFFF57FFFF56FFFF56FFFF55FFFF54FFFF54 FFFF53FFFF52FFFF52FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4EFFFF4DFFFF4CFFFF4CFFFF4B FFFF4AFFFF49FFFF49FFFF48FFFF47FFFF47FFFF46FFFF45FFFF44FFFF44FFFF42FFFF42FFFF41 FFFF3FFFFF3EFFFF3DFFFF3CFFFF3BFFFF39FFFF39FFFF38FFFF36FFFF34FFFF32FFFF31FFFF2F FFFF2EFFFF2DFFFF2CFFFF2BFFFF2AFFFF28FFFF27FFFF25FFFF24FFFF22FFFF20FFFF1EFFFF1C FFFF1AFFFF18FFFF17FFFF14FFFF14FFFF13D8D8114040320000D40000FF0000FF0000FF0000FA 000069000005000001FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF000000050502455B1C5D8D258B9F37A9B741BAC347DBDA54E5E256 F1EF59FAF95BFFFF5DFFFF5BFFFF5AFFFF59FFFF58FFFF57FFFF56FFFF56FFFF55FFFF54FFFF54 FFFF53FFFF52FFFF52FFFF51FFFF51FFFF50FFFF4FFFFF4EFFFF4EFFFF4DFFFF4DFFFF4CFFFF4B FFFF4BFFFF49FFFF49FFFF48FFFF48FFFF47FFFF46FFFF46FFFF45FFFF44FFFF43FFFF43FFFF42 FFFF41FFFF41FFFF40FFFF3FFFFF3EFFFF3DFFFF3DFFFF3CFFFF3BFFFF3AFFFF39FFFF39FFFF38 FFFF36FFFF33FFFF31FFFF30FFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF29FFFF29FFFF28FFFF26 FFFF24FFFF23FFFF21FFFF1FFFFF1DFFFF1BFFFF1AFFFF18FFFF16FFFF14FFFF13FFFF13F9F913 3C3C210202B80000FD0000FF0000FF0000FE0000B600000D000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0808039D9D40 FCFC65FEFE64FFFF62FFFF5FFFFF5EFFFF5CFFFF5AFFFF59FFFF58FFFF57FFFF55FFFF55FFFF54 FFFF53FFFF52FFFF52FFFF51FFFF51FFFF50FFFF4FFFFF4EFFFF4EFFFF4DFFFF4CFFFF4BFFFF4B FFFF4BFFFF4AFFFF49FFFF48FFFF48FFFF47FFFF46FFFF46FFFF44FFFF44FFFF43FFFF43FFFF42 FFFF41FFFF40FFFF3FFFFF3FFFFF3EFFFF3EFFFF3DFFFF3DFFFF3CFFFF3CFFFF3BFFFF3AFFFF39 FFFF39FFFF39FFFF39FFFF38FFFF36FFFF33FFFF31FFFF30FFFF2FFFFF2EFFFF2DFFFF2DFFFF2C FFFF2AFFFF29FFFF28FFFF26FFFF25FFFF24FFFF22FFFF21FFFF20FFFF1EFFFF1CFFFF1AFFFF19 FFFF17FFFF15FFFF14FFFF13FFFF12F4F41261610C0202A60000FF0000FF0000FF0000FF0000DB 000017000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF090903797930FBFB63FFFF62FFFF60FFFF5DFFFF5BFFFF59FFFF57 FFFF56FFFF54FFFF53FFFF52FFFF51FFFF50FFFF4FFFFF4FFFFF4EFFFF4DFFFF4CFFFF4BFFFF4B FFFF4AFFFF49FFFF49FFFF48FFFF48FFFF47FFFF46FFFF45FFFF45FFFF44FFFF43FFFF43FFFF42 FFFF41FFFF40FFFF40FFFF3FFFFF3EFFFF3EFFFF3DFFFF3DFFFF3CFFFF3BFFFF3BFFFF3AFFFF3A FFFF39FFFF39FFFF38FFFF38FFFF37FFFF37FFFF35FFFF34FFFF33FFFF32FFFF31FFFF30FFFF2F FFFF2EFFFF2DFFFF2CFFFF2BFFFF2AFFFF29FFFF28FFFF27FFFF26FFFF25FFFF23FFFF22FFFF20 FFFF1FFFFF1EFFFF1CFFFF1BFFFF19FFFF18FFFF16FFFF15FFFF13FFFF12FFFF11E5E510676718 0404970000FA0000FF0000FF0000FF0000E700004D000000000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0101005B5B24ECEC5C FFFF60FFFF5DFFFF5BFFFF58FFFF56FFFF54FFFF53FFFF51FFFF50FFFF4EFFFF4DFFFF4CFFFF4C FFFF4AFFFF4AFFFF49FFFF48FFFF48FFFF47FFFF46FFFF45FFFF45FFFF44FFFF43FFFF43FFFF42 FFFF41FFFF40FFFF40FFFF3FFFFF3EFFFF3EFFFF3DFFFF3DFFFF3CFFFF3BFFFF3BFFFF3AFFFF3A FFFF3AFFFF39FFFF39FFFF38FFFF38FFFF37FFFF36FFFF35FFFF34FFFF33FFFF32FFFF32FFFF31 FFFF30FFFF2FFFFF2EFFFF2EFFFF2DFFFF2CFFFF2BFFFF2AFFFF29FFFF28FFFF28FFFF26FFFF25 FFFF24FFFF23FFFF22FFFF21FFFF20FFFF1FFFFF1DFFFF1CFFFF1BFFFF1AFFFF18FFFF17FFFF15 FFFF14FFFF13FFFF12FEFE11E0E0104848260606A10000FA0000FF0000FF0000FF0000F4000069 000008FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF000000383816DDDD55FFFF5FFFFF5CFFFF59FFFF56FFFF54FFFF52FFFF50 FFFF4EFFFF4CFFFF4BFFFF4AFFFF49FFFF47FFFF46FFFF45FFFF45FFFF44FFFF43FFFF43FFFF42 FFFF41FFFF40FFFF40FFFF40FFFF3FFFFF3EFFFF3DFFFF3DFFFF3CFFFF3BFFFF3BFFFF3AFFFF39 FFFF39FFFF39FFFF38FFFF39FFFF38FFFF38FFFF37FFFF35FFFF34FFFF33FFFF32FFFF31FFFF30 FFFF30FFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF2BFFFF2AFFFF29FFFF29FFFF28FFFF27 FFFF27FFFF26FFFF25FFFF25FFFF23FFFF22FFFF21FFFF20FFFF1FFFFF1FFFFF1DFFFF1CFFFF1B FFFF1AFFFF19FFFF18FFFF17FFFF15FFFF14FFFF14FFFF12FFFF12FFFF11C4C40E36361A0000BD 0000FF0000FF0000FF0000FF0000FE000092000008000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000001C1C0AD6D652FEFE5D FFFF5AFFFF57FFFF54FFFF51FFFF4FFFFF4DFFFF4BFFFF49FFFF47FFFF46FFFF44FFFF43FFFF43 FFFF41FFFF40FFFF40FFFF3FFFFF3EFFFF3EFFFF3DFFFF3DFFFF3CFFFF3BFFFF3BFFFF3BFFFF39 FFFF3AFFFF39FFFF38FFFF38FFFF37FFFF37FFFF36FFFF35FFFF35FFFF34FFFF32FFFF31FFFF30 FFFF2FFFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF2BFFFF2AFFFF2AFFFF29FFFF28FFFF28 FFFF27FFFF26FFFF26FFFF25FFFF24FFFF23FFFF22FFFF22FFFF21FFFF20FFFF1FFFFF1EFFFF1E FFFF1DFFFF1CFFFF1BFFFF1AFFFF1AFFFF18FFFF18FFFF17FFFF15FFFF14FFFF14FFFF13FFFF12 FFFF11FFFF11EEEE108C8C1219194B0000E60000FE0000FF0000FF0000FF0000F800009B000005 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF0000001E1E0BB5B544FFFF5DFFFF59FFFF55FFFF52FFFF4FFFFF4CFFFF4AFFFF48 FFFF46FFFF44FFFF42FFFF41FFFF40FFFF3FFFFF3EFFFF3DFFFF3CFFFF3BFFFF3BFFFF3BFFFF3A FFFF3AFFFF39FFFF38FFFF39FFFF38FFFF37FFFF37FFFF35FFFF35FFFF34FFFF32FFFF32FFFF31 FFFF30FFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2CFFFF2BFFFF2AFFFF2AFFFF29FFFF28FFFF28 FFFF27FFFF26FFFF25FFFF25FFFF24FFFF24FFFF23FFFF22FFFF21FFFF20FFFF20FFFF1FFFFF1E FFFF1EFFFF1DFFFF1DFFFF1CFFFF1BFFFF1AFFFF1AFFFF19FFFF19FFFF18FFFF17FFFF16FFFF15 FFFF14FFFF14FFFF13FFFF13FFFF12FFFF11FFFF12FAFA11C7C70E4C4C290B0B8D0000EB0000FF 0000FF0000FF0000FF0000F5000092000010000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000F0F05969637FBFB5AFFFF57 FFFF54FFFF50FFFF4DFFFF4AFFFF48FFFF45FFFF43FFFF41FFFF40FFFF3EFFFF3DFFFF3CFFFF3A FFFF3AFFFF3AFFFF39FFFF39FFFF38FFFF38FFFF37FFFF36FFFF35FFFF33FFFF33FFFF32FFFF31 FFFF31FFFF2FFFFF2FFFFF2EFFFF2DFFFF2DFFFF2CFFFF2CFFFF2BFFFF2AFFFF29FFFF29FFFF28 FFFF27FFFF27FFFF26FFFF25FFFF24FFFF24FFFF23FFFF22FFFF21FFFF21FFFF20FFFF1FFFFF1E FFFF1EFFFF1DFFFF1DFFFF1BFFFF1BFFFF1BFFFF1BFFFF1AFFFF19FFFF19FFFF18FFFF17FFFF17 FFFF16FFFF16FFFF15FFFF15FFFF14FFFF13FFFF13FFFF12FFFF12FFFF12FFFF12FFFF12FEFE11 E7E7107D7D0D1717580000D10000FC0000FF0000FF0000FF0000FF0000FC00006E00000D000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF0000000505027A7A2CF4F457FFFF55FFFF51FFFF4EFFFF4BFFFF48FFFF45FFFF42FFFF3F FFFF3EFFFF3CFFFF3AFFFF39FFFF38FFFF38FFFF37FFFF36FFFF35FFFF34FFFF33FFFF31FFFF31 FFFF30FFFF2FFFFF2FFFFF2EFFFF2DFFFF2CFFFF2CFFFF2BFFFF2AFFFF2AFFFF29FFFF28FFFF28 FFFF27FFFF26FFFF26FFFF25FFFF24FFFF24FFFF23FFFF22FFFF21FFFF20FFFF1FFFFF1FFFFF1E FFFF1DFFFF1DFFFF1CFFFF1BFFFF1BFFFF1AFFFF1AFFFF19FFFF19FFFF18FFFF17FFFF17FFFF16 FFFF16FFFF15FFFF14FFFF14FFFF13FFFF13FFFF12FFFF12FFFF12FFFF12FFFF11FFFF11FFFF11 FFFF11FFFF11FFFF11FFFF10F9F910D2D20D83831314144A0000B80000FE0000FF0000FF0000FF 0000FF0000FF0000E300005F000002000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0303015A5A20EDED54FFFF54FFFF50 FFFF4CFFFF49FFFF45FFFF42FFFF3FFFFF3DFFFF3BFFFF39FFFF38FFFF37FFFF36FFFF34FFFF32 FFFF31FFFF30FFFF2FFFFF2EFFFF2DFFFF2DFFFF2CFFFF2BFFFF2BFFFF2AFFFF29FFFF29FFFF28 FFFF27FFFF27FFFF26FFFF25FFFF24FFFF24FFFF23FFFF22FFFF22FFFF20FFFF20FFFF1FFFFF1E FFFF1DFFFF1DFFFF1DFFFF1CFFFF1BFFFF1BFFFF1AFFFF19FFFF19FFFF18FFFF18FFFF17FFFF16 FFFF15FFFF15FFFF14FFFF14FFFF13FFFF13FFFF13FFFF12FFFF12FFFF11FFFF11FFFF11FFFF10 FFFF10FFFF10FFFF0FFFFF0FFFFF0FFFFF0FFFFF0FFFFF10F3F30FDEDE0DA1A11159592D1A1A66 0303BE0000EF0000FE0000FF0000FF0000FF0000FF0000FB0000BE00003E000004000000FFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF020201494919E1E14CFFFF52FFFF4EFFFF4AFFFF46FFFF43FFFF40FFFF3DFFFF3BFFFF39 FFFF37FFFF35FFFF33FFFF31FFFF2FFFFF2EFFFF2DFFFF2CFFFF2BFFFF2AFFFF29FFFF29FFFF28 FFFF27FFFF27FFFF26FFFF26FFFF25FFFF24FFFF23FFFF23FFFF22FFFF21FFFF20FFFF1FFFFF1F FFFF1EFFFF1DFFFF1DFFFF1BFFFF1BFFFF1AFFFF1AFFFF1AFFFF19FFFF18FFFF18FFFF17FFFF16 FFFF15FFFF15FFFF15FFFF14FFFF14FFFF13FFFF13FFFF12FFFF12FFFF11FFFF10FFFF10FFFF10 FFFF10FFFF0FFFFF0FFFFF0EFFFF0EFFFF0EFFFF0DFFFF0DFFFF0DFCFC0EF4F40DECEC0DE3E30E B6B60E8484135757252E2E590A0A9F0101D70000F80000FF0000FF0000FF0000FF0000FF0000FE 0000EF00008A000020000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000002C2C0ECBCB43FFFF50FFFF4CFFFF48 FFFF44FFFF41FFFF3DFFFF3BFFFF38FFFF36FFFF34FFFF31FFFF2FFFFF2DFFFF2BFFFF2AFFFF29 FFFF28FFFF27FFFF26FFFF25FFFF24FFFF24FFFF23FFFF23FFFF21FFFF21FFFF20FFFF1FFFFF1F FFFF1EFFFF1DFFFF1CFFFF1CFFFF1BFFFF1BFFFF1AFFFF19FFFF19FFFF18FFFF18FFFF17FFFF16 FFFF16FFFF15FFFF14FFFF14FFFF13FFFF13FFFF12FFFF12FFFF12FFFF11FFFF10FFFF10FFFF10 FFFF0FFFFF0EFFFF0EFFFF0EFFFF0EFFFF0EFFFF0EFFFF0EFFFF0EFEFE0DFCFC0DFAFA0DF4F40C BEBE0CA7A70C81810C6F6F1C4444471A1A710707810404A00101CB0000F50000FC0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FB0000B8000038000002000001FFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 000000141406B4B43BFCFC4EFFFF4AFFFF45FFFF41FFFF3EFFFF3BFFFF38FFFF35FFFF32FFFF2F FFFF2DFFFF2BFFFF29FFFF27FFFF26FFFF25FFFF24FFFF23FFFF22FFFF21FFFF20FFFF1FFFFF1F FFFF1EFFFF1DFFFF1DFFFF1CFFFF1BFFFF1BFFFF1AFFFF19FFFF19FFFF18FFFF18FFFF17FFFF17 FFFF16FFFF15FFFF14FFFF14FFFF13FFFF13FFFF12FFFF12FFFF11FFFF11FFFF10FFFF10FFFF0F FFFF0FFFFF0EFFFF0EFFFF0EFFFF0DFFFF0DFFFF0DFFFF0EFFFF0EFDFD0DF1F10BE7E70ADBDB0A C0C013AFAF189191247A7A314A4A4F1F1F6B1212780A0AB00606C70101E90000EF0000F60000FC 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000F70000C7000066 000011000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000D0D049C9C30F9F94BFFFF47FFFF43FFFF3F FFFF3BFFFF38FFFF35FFFF32FFFF2FFFFF2CFFFF2AFFFF28FFFF26FFFF24FFFF23FFFF21FFFF20 FFFF1FFFFF1EFFFF1DFFFF1CFFFF1BFFFF1BFFFF1AFFFF19FFFF19FFFF18FFFF18FFFF17FFFF16 FFFF16FFFF16FFFF15FFFF14FFFF14FFFF13FFFF12FFFF12FFFF12FFFF11FFFF10FFFF10FFFF10 FFFF0FFFFF0FFFFF0EFFFF0EFFFF0DFFFF0DFFFF0DFFFF0DFFFF0EFDFD0DF1F10CEAEA0CDEDE0C C5C510AFAF148A8A2077772950504E3B3B692525871717A40F0FB50202D30000DE0000EE0000FB 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FE0000EF0000C600006400001C000001000001FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 040401727222FCFC49FFFF45FFFF40FFFF3CFFFF39FFFF35FFFF32FFFF2FFFFF2BFFFF29FFFF26 FFFF24FFFF22FFFF20FFFF1EFFFF1DFFFF1CFFFF1BFFFF1AFFFF19FFFF18FFFF18FFFF17FFFF16 FFFF16FFFF15FFFF15FFFF14FFFF14FFFF13FFFF13FFFF13FFFF12FFFF12FFFF11FFFF10FFFF10 FFFF0FFFFF0FFFFF0EFFFF0EFFFF0DFFFF0DFFFF0DFFFF0DFFFF0EFFFF0DFFFF0EFFFF0EFFFF0E EDED0CBABA088686066C6C0E4A4A403838591717890F0FA40909B90202DB0000EB0000F50000FA 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000ED00009600004600000E000002000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000063631CF2F244FFFF41FFFF3DFFFF3AFFFF36 FFFF32FFFF2FFFFF2AFFFF27FFFF24FFFF22FFFF20FFFF1DFFFF1CFFFF1AFFFF19FFFF18FFFF17 FFFF16FFFF15FFFF15FFFF13FFFF13FFFF12FFFF12FFFF11FFFF11FFFF11FFFF10FFFF10FFFF10 FFFF0EFFFF0EFFFF0EFFFF0EFFFF0DFFFF0DFFFF0DFFFF0EFFFF0EFEFE0EF8F80CF4F40CECEC09 D9D90CB8B813A3A3188A8A2059593E3E3E4F0B0B6B0202850101BB0000EB0000FD0000FE0000FE 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FE0000F80000EE0000CE0000A0 00005200000B000001000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000 3D3D11DBDB3AFFFF40FFFF3BFFFF37FFFF33FFFF2EFFFF2AFFFF27FFFF24FFFF21FFFF1EFFFF1C FFFF1AFFFF18FFFF17FFFF15FFFF14FFFF14FFFF13FFFF11FFFF11FFFF11FFFF10FFFF0FFFFF0F FFFF0FFFFF0EFFFF0EFFFF0DFFFF0DFFFF0DFFFF0DFFFF0DFFFF0DFFFF0DF6F60BEDED0ADFDF0A D4D40BB3B315A2A21A82822A5D5D444D4D532C2C701E1E8C1010B00808C50000DC0000E90000F1 0000FD0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FE0000F30000EA0000D90000D5 0000B100009900007C00005C00003F00001A000007000000000000FFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000181806C8C832FFFF3DFFFF38FFFF33FFFF2FFFFF2B FFFF27FFFF23FFFF20FFFF1DFFFF1BFFFF19FFFF17FFFF15FFFF13FFFF12FFFF11FFFF10FFFF10 FFFF0FFFFF0EFFFF0EFFFF0DFFFF0DFFFF0CFFFF0DFFFF0DFFFF0CFFFF0CFDFD0CF7F70BF2F20B EDED0CC8C80BAFAF0D7979135D5D314A4A4B2B2B791E1E910F0FB20808C10000DE0000EC0000F1 0000FC0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FA0000F70000F20000EB 0000B500009300006E00005A00004B00002400001D00001300000B000000000000000001000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF101004 BABA2DFFFF3AFFFF35FFFF30FFFF2CFFFF27FFFF23FFFF20FFFF1CFFFF19FFFF17FFFF14FFFF13 FFFF12FFFF10FFFF0FFFFF0FFFFF0DFFFF0CFFFF0CFFFF0CFFFF0CFFFF0CFEFE0CFAFA0BF7F70A F1F10ACACA0DB6B60E8C8C1073732046464715156C02027D0101A70101C00000F40000FD0000FD 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FE0000F90000F60000F1 0000CB0000AA000088000062000042000017000002000003000001000000000000000000000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0E0E03959523FBFB38FFFF33FFFF2FFFFF29FFFF24FFFF20 FFFF1DFFFF19FFFF16FFFF14FFFF11FFFF10FFFF0EFFFF0EFFFF0DFFFF0CFDFD0BF0F008E9E907 DCDC07C5C50FAFAF168E8E247878324E4E4F3535611919781010A10B0BB70101DF0000E90000F3 0000FC0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FD0000EE0000E30000D6 0000C00000AF00008C000079000053000037000019000010000008000001000000000000000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000404016E6E19 F0F035FFFF32FFFF2DFFFF27FFFF22FFFF1EFFFF1AFFFF17FFFF14FFFF11FDFD0FF3F30CEDED0B E2E20BC9C90DB1B11187871C72722651514A40405E2828841B1B9E1010B40202D50000DF0000EE 0000F60000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FD0000F10000EC0000E2 0000C60000AD00008500007200005600003F000023000019000013000003000000000000000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFF000000444410F2F235FFFF32FFFF2DFFFF26FFFF20FFFF1DFFFF19 FFFF15EAEA10BBBB0C9B9B086E6E0F4A4A3F3636581111870B0BA40707BA0101E00000F10000F7 0000FA0000FE0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000D80000BA00009900006F00004600003400001100000D00000B000003000000000000000000 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000034340BDCDC2F E7E72AD5D526B7B727A8A8258B8B2B5C5C454646501919690808860505B60303D30000F60000FA 0000FB0000FE0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000F70000F00000E5 0000D60000B90000A400008A00005D000043000013000007000005000003000000000000000000 000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF0000030304173031444E4E5E2E2E781F1F911212B00B0BBF0101D80000E8 0000EE0000FB0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000F50000EC0000DF 0000D50000B100009700007A00006800005500002F00002000001400000A000000000000000000 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000001100009A40007EC 0001F30000FC0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FE0000FB0000F8 0000F00000BA0000A100007300005C00004A00002900001900001200000A000000000000000000 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFF000001000F9D0011FB000BFF0005FF0000FF0000FF0000FF0000FF0000FF 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FD0000F70000F2 0000EA0000CA0000B7000092000078000044000014000000000000000000000000FFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000109000B630019FB0014FF 000EFF0008FF0002FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FD0000EE0000E6 0000D60000BF0000AF00008800007700005500003B00001D00001300000E000002000000000000 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFF000002010B55011DEB001AFF0016FF0010FF000AFF0005FF0001FD0000F40000F2 0000E80000C90000B100009200006E000055000044000023000019000013000003000000000000 000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000020A42051FDC0220FD001BFC 0018FB0012E80009BB00059E00027500004800003E00000F000008000008000005000000000000 000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFF000000000001041169041489010C6000084C00032000010F000009000005000000000000 000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000001020D000000000000 000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF end %%PageTrailer %%Trailer %%EOF ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/����������������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021361015�012101� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/�������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013613� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/PPC_SIGSEGV.c������������������������������������������������������������0000644�0001750�0001750�00000002654�13021324543�015573� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <signal.h> #include <stdio.h> typedef long WamWord; #if 0 void SIGSEGV_Handler(int sig) { /* LINUX: recovering the bad address... */ /* There is no documented way to get the address that has */ /* caused SIGSEGV. I have looked at the sources of the kernel */ /* (files from /usr/src/linux/arch/i386/) */ /* */ /* mm/fault.c:104: current->tss.cr2 = address; */ /* a bad address is found by the memory manager. */ /* */ /* kernel/signal.c:203: put_user(current->tss.cr2, frame+23); */ /* a context pointed by 'frame' is created in the stack, */ /* it contains the bad addess at +23. */ /* Inside the handler SIGSEGV_Handler(int sig) the context */ /* (frame) can be found at &sig-1. */ long *frame = (long *) &sig - 1; WamWord *addr = (WamWord *) (frame[+23]); printf("Segmentation Violation at: %lx\n", addr); exit(1); } #else #include <asm/sigcontext.h> void SIGSEGV_Handler(int sig, struct sigcontext_struct scp) { WamWord *addr = (WamWord *) scp.regs->dar; printf("Segmentation Violation at: %lx\n", addr); exit(1); } #endif main() { long *x; signal(SIGSEGV, (void (*)()) SIGSEGV_Handler); x = (long *) 0xffff040; *x = 12; } ������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/machine1.c���������������������������������������������������������������0000644�0001750�0001750�00000112020�13021324543�015434� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine + Compiler * * File : machine1.c * * Descr.: machine dependent features * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <ctype.h> #include <string.h> #include <errno.h> #include "gp_config.h" #include "bool.h" #if 0 #define USE_ALONE #define DEBUG #if 0 #define USE_W32_GUI_CONSOLE #endif #endif #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #include <sys/types.h> #include <sys/wait.h> #include <sys/stat.h> #include <sys/utsname.h> #include <sys/param.h> #include <time.h> #else #include <windows.h> #include <winnt.h> #include <process.h> #include <io.h> #include <fcntl.h> #endif #ifdef __CYGWIN__ #include <process.h> #endif #define MACHINE1_FILE #include "machine1.h" #ifdef USE_W32_GUI_CONSOLE #include "../Linedit/linedit.h" #define printf LE_Printf #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #if defined(_WIN32) && !defined(CYGWIN) static Bool Get_Windows_OS_Name(char *buff); #endif /*-------------------------------------------------------------------------* * PL_INIT_MACHINE1 * * * *-------------------------------------------------------------------------*/ void Pl_Init_Machine1(void) { #if defined(__unix__) || defined(__CYGWIN__) struct utsname uname_info; pl_m_os_type = M_OS_UNIX; if (uname(&uname_info) < 0) { strcpy(pl_m_architecture, "unknown architecture"); strcpy(pl_m_os_version, "unknown OS version"); return; } strcpy(pl_m_architecture, uname_info.machine); sprintf(pl_m_os_version, "%s %s", uname_info.sysname, uname_info.release); #else SYSTEM_INFO si; GetSystemInfo(&si); if (si.wProcessorLevel >= 3 && si.wProcessorLevel < 10) sprintf(pl_m_architecture, "i%c86", si.wProcessorLevel + '0'); else sprintf(pl_m_architecture, "i%ld", si.dwProcessorType); pl_m_os_type = M_OS_WINDOWS; if (!Get_Windows_OS_Name(pl_m_os_version)) strcpy(pl_m_os_version, "unknown OS version"); #endif } #if defined(_WIN32) && !defined(__CYGWIN__) /* This is for MinGW (gcc 4.6.2), not mingw-w64 * Fix a lot of missing definitions in winnt.h from MSDN */ #ifndef PRODUCT_ULTIMATE #define VER_SUITE_WH_SERVER 0x00008000 #define PRODUCT_UNDEFINED 0x0 #define PRODUCT_ULTIMATE 0x1 #define PRODUCT_HOME_BASIC 0x2 #define PRODUCT_HOME_PREMIUM 0x3 #define PRODUCT_ENTERPRISE 0x4 #define PRODUCT_HOME_BASIC_N 0x5 #define PRODUCT_BUSINESS 0x6 #define PRODUCT_STANDARD_SERVER 0x7 #define PRODUCT_DATACENTER_SERVER 0x8 #define PRODUCT_SMALLBUSINESS_SERVER 0x9 #define PRODUCT_ENTERPRISE_SERVER 0xa #define PRODUCT_STARTER 0xb #define PRODUCT_DATACENTER_SERVER_CORE 0xc #define PRODUCT_STANDARD_SERVER_CORE 0xd #define PRODUCT_ENTERPRISE_SERVER_CORE 0xe #define PRODUCT_ENTERPRISE_SERVER_IA64 0xf #define PRODUCT_BUSINESS_N 0x10 #define PRODUCT_WEB_SERVER 0x11 #define PRODUCT_CLUSTER_SERVER 0x12 #define PRODUCT_HOME_SERVER 0x13 #define PRODUCT_STORAGE_EXPRESS_SERVER 0x14 #define PRODUCT_STORAGE_STANDARD_SERVER 0x15 #define PRODUCT_STORAGE_WORKGROUP_SERVER 0x16 #define PRODUCT_STORAGE_ENTERPRISE_SERVER 0x17 #define PRODUCT_SERVER_FOR_SMALLBUSINESS 0x18 #define PRODUCT_SMALLBUSINESS_SERVER_PREMIUM 0x19 #define PRODUCT_HOME_PREMIUM_N 0x1a #define PRODUCT_ENTERPRISE_N 0x1b #define PRODUCT_ULTIMATE_N 0x1c #define PRODUCT_WEB_SERVER_CORE 0x1d #define PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT 0x1e #define PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY 0x1f #define PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING 0x20 #define PRODUCT_SERVER_FOUNDATION 0x21 #define PRODUCT_HOME_PREMIUM_SERVER 0x22 #define PRODUCT_SERVER_FOR_SMALLBUSINESS_V 0x23 #define PRODUCT_STANDARD_SERVER_V 0x24 #define PRODUCT_DATACENTER_SERVER_V 0x25 #define PRODUCT_ENTERPRISE_SERVER_V 0x26 #define PRODUCT_DATACENTER_SERVER_CORE_V 0x27 #define PRODUCT_STANDARD_SERVER_CORE_V 0x28 #define PRODUCT_ENTERPRISE_SERVER_CORE_V 0x29 #define PRODUCT_HYPERV 0x2a #define PRODUCT_STORAGE_EXPRESS_SERVER_CORE 0x2b #define PRODUCT_STORAGE_STANDARD_SERVER_CORE 0x2c #define PRODUCT_STORAGE_WORKGROUP_SERVER_CORE 0x2d #define PRODUCT_STORAGE_ENTERPRISE_SERVER_CORE 0x2e #define PRODUCT_STARTER_N 0x2f #define PRODUCT_PROFESSIONAL 0x30 #define PRODUCT_PROFESSIONAL_N 0x31 #define PRODUCT_SB_SOLUTION_SERVER 0x32 #define PRODUCT_SERVER_FOR_SB_SOLUTIONS 0x33 #define PRODUCT_STANDARD_SERVER_SOLUTIONS 0x34 #define PRODUCT_STANDARD_SERVER_SOLUTIONS_CORE 0x35 #define PRODUCT_SB_SOLUTION_SERVER_EM 0x36 #define PRODUCT_SERVER_FOR_SB_SOLUTIONS_EM 0x37 #define PRODUCT_SOLUTION_EMBEDDEDSERVER 0x38 #define PRODUCT_SOLUTION_EMBEDDEDSERVER_CORE 0x39 #define PRODUCT_ESSENTIALBUSINESS_SERVER_MGMT 0x3B #define PRODUCT_ESSENTIALBUSINESS_SERVER_ADDL 0x3C #define PRODUCT_ESSENTIALBUSINESS_SERVER_MGMTSVC 0x3D #define PRODUCT_ESSENTIALBUSINESS_SERVER_ADDLSVC 0x3E #define PRODUCT_SMALLBUSINESS_SERVER_PREMIUM_CORE 0x3f #define PRODUCT_CLUSTER_SERVER_V 0x40 #define PRODUCT_EMBEDDED 0x41 #define PRODUCT_STARTER_E 0x42 #define PRODUCT_HOME_BASIC_E 0x43 #define PRODUCT_HOME_PREMIUM_E 0x44 #define PRODUCT_PROFESSIONAL_E 0x45 #define PRODUCT_ENTERPRISE_E 0x46 #define PRODUCT_ULTIMATE_E 0x47 #define PRODUCT_UNLICENSED 0xabcdabcd #endif /* !PRODUCT_ULTIMATE_E */ /*-------------------------------------------------------------------------* * GET_WINDOWS_OS_NAME * * * * code obtained from * * http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ * * sysinfo/base/getting_the_system_version.asp * * then: * * - indent (with -gnu -bap -bad -npcs -cs -l80 -lc80) * * - replace function by "static Bool Get_Windows_OS_Name(char *pszOS)" * * - fix bug replace if(bOsVersionInfoEx != NULL ) return 1; by * * if(bOsVersionInfoEx == 0) return FALSE; * * - after "if (VER_PLATFORM_WIN32_NT == osvi.dwPlatformId..." add * * pl_m_os_type = M_OS_WINDOWS_NT; * * - add the following defines (BUFSIZE is ignored) * * #define StringCchCat(d, sz, s) strcat(d, s) * * #define StringCchCopy(d, sz, s) strcpy(d, s) * * #define StringCchPrintf(b, sz, fmt, ...) sprintf(b, fmt, __VA_ARGS__)* * - fix warnings %d -> %ld * *-------------------------------------------------------------------------*/ static Bool Get_Windows_OS_Name(char *pszOS) { typedef void (WINAPI *PGNSI) (LPSYSTEM_INFO); typedef BOOL (WINAPI *PGPI) (DWORD, DWORD, DWORD, DWORD, PDWORD); #define StringCchCat(d, sz, s) strcat(d, s) #define StringCchCopy(d, sz, s) strcpy(d, s) #define StringCchPrintf(b, sz, fmt, ...) sprintf(b, fmt, __VA_ARGS__) OSVERSIONINFOEX osvi; SYSTEM_INFO si; PGNSI pGNSI; PGPI pGPI; BOOL bOsVersionInfoEx; DWORD dwType; TCHAR buf[80]; ZeroMemory(&si, sizeof(SYSTEM_INFO)); ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX)); osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); bOsVersionInfoEx = GetVersionEx((OSVERSIONINFO *) & osvi); if (bOsVersionInfoEx == 0) return FALSE; // Call GetNativeSystemInfo if supported or GetSystemInfo otherwise. pGNSI = (PGNSI) GetProcAddress(GetModuleHandle(TEXT("kernel32.dll")), "GetNativeSystemInfo"); if (NULL != pGNSI) pGNSI(&si); else GetSystemInfo(&si); if (VER_PLATFORM_WIN32_NT == osvi.dwPlatformId && osvi.dwMajorVersion > 4) { pl_m_os_type = M_OS_WINDOWS_NT; StringCchCopy(pszOS, BUFSIZE, TEXT("Microsoft ")); // Test for the specific product. if (osvi.dwMajorVersion == 6) { if (osvi.dwMinorVersion == 0) { if (osvi.wProductType == VER_NT_WORKSTATION) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Vista ")); else StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2008 ")); } if (osvi.dwMinorVersion == 1) { if (osvi.wProductType == VER_NT_WORKSTATION) StringCchCat(pszOS, BUFSIZE, TEXT("Windows 7 ")); else StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2008 R2 ")); } pGPI = (PGPI) GetProcAddress(GetModuleHandle(TEXT("kernel32.dll")), "GetProductInfo"); pGPI(osvi.dwMajorVersion, osvi.dwMinorVersion, 0, 0, &dwType); switch (dwType) { case PRODUCT_ULTIMATE: StringCchCat(pszOS, BUFSIZE, TEXT("Ultimate Edition")); break; case PRODUCT_PROFESSIONAL: StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); break; case PRODUCT_HOME_PREMIUM: StringCchCat(pszOS, BUFSIZE, TEXT("Home Premium Edition")); break; case PRODUCT_HOME_BASIC: StringCchCat(pszOS, BUFSIZE, TEXT("Home Basic Edition")); break; case PRODUCT_ENTERPRISE: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); break; case PRODUCT_BUSINESS: StringCchCat(pszOS, BUFSIZE, TEXT("Business Edition")); break; case PRODUCT_STARTER: StringCchCat(pszOS, BUFSIZE, TEXT("Starter Edition")); break; case PRODUCT_CLUSTER_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Cluster Server Edition")); break; case PRODUCT_DATACENTER_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition")); break; case PRODUCT_DATACENTER_SERVER_CORE: StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition (core installation)")); break; case PRODUCT_ENTERPRISE_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); break; case PRODUCT_ENTERPRISE_SERVER_CORE: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition (core installation)")); break; case PRODUCT_ENTERPRISE_SERVER_IA64: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition for Itanium-based Systems")); break; case PRODUCT_SMALLBUSINESS_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Small Business Server")); break; case PRODUCT_SMALLBUSINESS_SERVER_PREMIUM: StringCchCat(pszOS, BUFSIZE, TEXT("Small Business Server Premium Edition")); break; case PRODUCT_STANDARD_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition")); break; case PRODUCT_STANDARD_SERVER_CORE: StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition (core installation)")); break; case PRODUCT_WEB_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Web Server Edition")); break; } } if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2) { if (GetSystemMetrics(SM_SERVERR2)) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2003 R2, ")); else if (osvi.wSuiteMask & VER_SUITE_STORAGE_SERVER) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Storage Server 2003")); else if (osvi.wSuiteMask & VER_SUITE_WH_SERVER) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Home Server")); else if (osvi.wProductType == VER_NT_WORKSTATION && si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) { StringCchCat(pszOS, BUFSIZE, TEXT("Windows XP Professional x64 Edition")); } else StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2003, ")); // Test for the server type. if (osvi.wProductType != VER_NT_WORKSTATION) { if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_IA64) { if (osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition for Itanium-based Systems")); else if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition for Itanium-based Systems")); } else if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) { if (osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter x64 Edition")); else if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise x64 Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Standard x64 Edition")); } else { if (osvi.wSuiteMask & VER_SUITE_COMPUTE_SERVER) StringCchCat(pszOS, BUFSIZE, TEXT("Compute Cluster Edition")); else if (osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition")); else if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); else if (osvi.wSuiteMask & VER_SUITE_BLADE) StringCchCat(pszOS, BUFSIZE, TEXT("Web Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition")); } } } if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1) { StringCchCat(pszOS, BUFSIZE, TEXT("Windows XP ")); if (osvi.wSuiteMask & VER_SUITE_PERSONAL) StringCchCat(pszOS, BUFSIZE, TEXT("Home Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); } if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0) { StringCchCat(pszOS, BUFSIZE, TEXT("Windows 2000 ")); if (osvi.wProductType == VER_NT_WORKSTATION) { StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); } else { if (osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Server")); else if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Advanced Server")); else StringCchCat(pszOS, BUFSIZE, TEXT("Server")); } } // Include service pack (if any) and build number. if (strlen(osvi.szCSDVersion) > 0) { StringCchCat(pszOS, BUFSIZE, TEXT(" ")); StringCchCat(pszOS, BUFSIZE, osvi.szCSDVersion); } StringCchPrintf(buf, 80, TEXT(" (build %ld)"), osvi.dwBuildNumber); StringCchCat(pszOS, BUFSIZE, buf); if (osvi.dwMajorVersion >= 6) { if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) StringCchCat(pszOS, BUFSIZE, TEXT(", 64-bit")); else if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_INTEL) StringCchCat(pszOS, BUFSIZE, TEXT(", 32-bit")); } return TRUE; } else { return FALSE; } } #endif /*-------------------------------------------------------------------------* * PL_M_CREATE_SHELL_COMMAND * * * * Create a shell command if != NULL (or else a shell invocation) * *-------------------------------------------------------------------------*/ char ** Pl_M_Create_Shell_Command(char *cmd) { static char *arg[4]; char *p; #if defined(__unix__) || defined(__CYGWIN__) arg[0] = ((p = getenv("SHELL")) != NULL) ? p : "/bin/sh"; arg[1] = "-c"; #else arg[0] = ((p = getenv("COMSPEC")) != NULL) ? p : (pl_m_os_type == M_OS_WINDOWS_NT) ? "cmd.exe" : "c:\\command.com"; arg[1] = "/c"; #endif if (cmd) { arg[2] = cmd; arg[3] = NULL; } else arg[1] = NULL; return arg; } /*-------------------------------------------------------------------------* * PL_M_CMD_LINE_TO_ARGV * * * *-------------------------------------------------------------------------*/ char ** Pl_M_Cmd_Line_To_Argv(char *cmd, int *argc) { static char **arg = NULL; static int nb_arg = 0; char *p = cmd; int i = 0; for (;;) { while (*p == ' ' || *p == '\t') p++; if (*p == '\0') break; if (i >= nb_arg) { nb_arg += 64; arg = (arg == NULL) ? malloc(nb_arg * sizeof(char *)) : realloc(arg, nb_arg * sizeof(char *)); } arg[i++] = p; while (*p != ' ' && *p != '\t' && *p != '\0') { if (*p == '"') { do p++; while (*p != '"' && *p != '\0'); if (*p == '"') p++; } else p++; } if (*p == '\0') break; *p++ = '\0'; } arg[i] = NULL; if (argc != NULL) *argc = i; return arg; } /*-------------------------------------------------------------------------* * PL_M_SHELL * * * * Invoke a shell (eventually passing a cmd if != NULL) * *-------------------------------------------------------------------------*/ int Pl_M_Shell(char *cmd) { return Pl_M_Spawn(Pl_M_Create_Shell_Command(cmd)); } /*-------------------------------------------------------------------------* * PL_M_SPAWN * * * * Execute a command with arguments in arg[], (arg[0]=the name of the cmd) * * a NULL must follow the last argument. * * if arg[1]==(char *) 1 then arg[0] is considered as a command-line. * * return the status or -1 if cannot execute (errno is set) or -2 else * * (errno is not set). * *-------------------------------------------------------------------------*/ int Pl_M_Spawn(char *arg[]) { #if defined(__unix__) int pid; fflush(stdout); fflush(stderr); if (arg[1] == (char *) 1) arg = Pl_M_Cmd_Line_To_Argv(arg[0], NULL); pid = fork(); if (pid == -1) return -1; if (pid == 0) /* child process */ { execvp(arg[0], arg); /* only returns on error */ exit((errno == ENOENT || errno == ENOTDIR) ? 126 : 127); } return Pl_M_Get_Status(pid); #else #if defined(_MSC_VER) _flushall(); #endif /* printf("COMMAND: <%s>\n", arg[0]); */ if (arg[1] == (char *) 1) arg = Pl_M_Cmd_Line_To_Argv(arg[0], NULL); /* { int i; for(i = 0; arg[i] != NULL; i++) printf("Arg :%d: <%s>\n", i, arg[i]); } */ return spawnvp(_P_WAIT, arg[0], (char *const *) arg); #endif } /*-------------------------------------------------------------------------* * PL_M_SPAWN_REDIRECT * * * * Execute a command with arguments in arg[], (arg[0]=the name of the cmd) * * a NULL must follow the last argument. * * if arg[1]==(char *) 1 then arg[0] is considered as a command-line. * * detach: 1 for a detached process (cannot obtain its status then). * * f_in, f_out, f_err: ptrs to FILE * vars. if NULL not redirected, * * f_out==f_err the 2 output streams are merged in f_out. * * In case of error return -1 if errno is set or else -2. * * In case of success, return 0 if detached or the pid else (the function * * Pl_M_Get_Status() should be called later to avoid zombie processes). * *-------------------------------------------------------------------------*/ int Pl_M_Spawn_Redirect(char *arg[], int detach, FILE **f_in, FILE **f_out, FILE **f_err) { #if defined(__unix__ ) || defined(__CYGWIN__) int pipe_in[2], pipe_out[2], pipe_err[2]; int pid, status; fflush(stdout); fflush(stderr); if (arg[1] == (char *) 1) arg = Pl_M_Cmd_Line_To_Argv(arg[0], NULL); if ((f_in && pipe(pipe_in)) || (f_out && pipe(pipe_out)) || (f_err && f_err != f_out && pipe(pipe_err))) goto err; pid = (int) fork(); if (pid == -1) goto err; if (pid == 0) /* the child process */ { if (!detach || fork() == 0) /* pid needed ? */ { /* nested fork to detach exec process to avoid zombie process */ if (f_in && (close(pipe_in[1]) || (pipe_in[0] != 0 && (dup2(pipe_in[0], 0) == -1 || close(pipe_in[0]))))) goto err; if (f_out && (close(pipe_out[0]) || (pipe_out[1] != 1 && (dup2(pipe_out[1], 1) == -1 || close(pipe_out[1]))))) goto err; if (f_err) { if (f_err != f_out) { if (close(pipe_err[0]) || (pipe_err[1] != 2 && (dup2(pipe_err[1], 2) == -1 || close(pipe_err[1])))) goto err; } else if (dup2(1, 2) == -1) goto err; } execvp(arg[0], arg); /* only returns on error */ #ifdef DEBUG DBGPRINTF("ERROR EXEC errno=%d\n", errno); #endif exit((errno == ENOENT || errno == ENOTDIR) ? 126 : 127); } else exit(0); /* detatch: terminate child */ } if (detach) /* wait child termination */ { if (waitpid(pid, &status, 0) < 0) goto err; pid = 0; } if (f_in && (close(pipe_in[0]) || (*f_in = fdopen(pipe_in[1], "wt")) == NULL)) goto err; if (f_out && (close(pipe_out[1]) || (*f_out = fdopen(pipe_out[0], "rt")) == NULL)) goto err; if (f_err && f_err != f_out && (close(pipe_err[1]) || (*f_err = fdopen(pipe_err[0], "rt")) == NULL)) goto err; return pid; /* NB: if detach: pid = 0 */ err: return -1; #else int status; SECURITY_ATTRIBUTES sa = { 0 }; STARTUPINFO si = { 0 }; PROCESS_INFORMATION pi = { 0 }; HANDLE pipe_in_r = NULL; HANDLE pipe_in_w = NULL; HANDLE pipe_out_r = NULL; HANDLE pipe_out_w = NULL; HANDLE pipe_err_r = NULL; HANDLE pipe_err_w = NULL; static char buff[4096]; char *cmd, *p; static char delim[2] = { '\0', '\0' }; int i, n; sa.nLength = sizeof(sa); sa.bInheritHandle = TRUE; sa.lpSecurityDescriptor = NULL; if ((f_in && !CreatePipe(&pipe_in_r, &pipe_in_w, &sa, 0)) || (f_out && !CreatePipe(&pipe_out_r, &pipe_out_w, &sa, 0)) || (f_err && f_err != f_out && !CreatePipe(&pipe_err_r, &pipe_err_w, &sa, 0))) goto windows_err; si.cb = sizeof(si); si.dwFlags = STARTF_USESHOWWINDOW | STARTF_USESTDHANDLES; si.wShowWindow = SW_HIDE; si.hStdInput = (f_in) ? pipe_in_r : GetStdHandle(STD_INPUT_HANDLE); si.hStdOutput = (f_out) ? pipe_out_w : GetStdHandle(STD_OUTPUT_HANDLE); si.hStdError = (f_err) ? ((f_err == f_out) ? pipe_out_w : pipe_err_w) : GetStdHandle(STD_ERROR_HANDLE); if (arg[1] == NULL || arg[1] == (char *) 1) cmd = arg[0]; else { for (n = i = 0; arg[i]; i++) { *delim = '\0'; for (p = arg[i]; *p; p++) if (*p == ' ' || *p == '\t') { *delim = '"'; break; } n += sprintf(buff + n, "%s%s%s ", delim, arg[i], delim); } buff[n - 1] = '\0'; cmd = buff; } #ifdef DEBUG DBGPRINTF(" cmd=<%s>\n", cmd); #endif if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, (detach) ? DETACHED_PROCESS : 0, NULL, NULL, &si, &pi)) { status = GetLastError(); #ifdef DEBUG DBGPRINTF("ERROR from Create_Process=%d\n", status); #endif if (status == ERROR_FILE_NOT_FOUND || status == ERROR_PATH_NOT_FOUND) { errno = ENOENT; goto err; } goto windows_err; } if ((f_in && !CloseHandle(pipe_in_r)) || (f_out && !CloseHandle(pipe_out_w)) || (f_err && f_err != f_out && !CloseHandle(pipe_err_w))) goto windows_err; if (f_in && (*f_in = fdopen(_open_osfhandle((PlLong) pipe_in_w, _O_TEXT), "wt")) == NULL) goto err; if (f_out && (*f_out = fdopen(_open_osfhandle((PlLong) pipe_out_r, _O_TEXT), "rt")) == NULL) goto err; if (f_err && f_err != f_out && (*f_err = fdopen(_open_osfhandle((PlLong) pipe_err_r, _O_TEXT), "rt")) == NULL) goto err; /* return (detach) ? 0 : (int) pi.hProcess; * JAT: Changed to use id rather than handle (64 bits) because of fixed bitness * OpenProcess function may be needed else where to get handle back */ return (detach) ? 0 : pi.dwProcessId; err: return -1; windows_err: return M_ERROR_WIN32; #endif } /*-------------------------------------------------------------------------* * PL_M_GET_STATUS * * * *-------------------------------------------------------------------------*/ int Pl_M_Get_Status(int pid) { int status = 0; #if defined(__unix__) || defined(__CYGWIN__) if (waitpid(pid, &status, 0) < 0) return -1; if (WIFEXITED(status)) { status = WEXITSTATUS(status); if (status == 127) status = -2; else if (status == 126) { status = -1; errno = ENOENT; } } #elif defined(_WIN32) /* JAT: See above * DD (bug XP/Vista) HANDLE phandle = OpenProcess(PROCESS_ALL_ACCESS, 1, pid); */ HANDLE phandle = OpenProcess(SYNCHRONIZE | PROCESS_QUERY_INFORMATION, 1, pid); if (phandle == 0) { #ifdef DEBUG printf("ERROR from OpenProcess: %d\n", (int) GetLastError()); #endif status = M_ERROR_WIN32; return status; } if (WaitForSingleObject(phandle, INFINITE) == WAIT_FAILED) { #ifdef DEBUG printf("ERROR from WaitForSingleObject: %d\n", (int) GetLastError()); #endif status = M_ERROR_WIN32; } else if (!GetExitCodeProcess(phandle, (LPDWORD) &status)) { #ifdef DEBUG printf("ERROR from GetExitCodeProcess: %d\n", (int) GetLastError()); #endif status = M_ERROR_WIN32; } CloseHandle(phandle); #endif return status; } /*-------------------------------------------------------------------------* * PL_M_MKTEMP * * * *-------------------------------------------------------------------------*/ char * Pl_M_Mktemp(char *tmpl) { /* redefined to avoid link warning */ #if defined(__unix__) || defined(__CYGWIN__) /* this code comes from glibc */ int len; char *XXXXXX; static PlULong value; int count; struct stat buf; static const char letters[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; #ifndef TMP_MAX #define TMP_MAX 238328 #endif len = strlen (tmpl); if (len < 6 || strcmp(&tmpl[len - 6], "XXXXXX")) { errno = EINVAL; return NULL; } /* This is where the Xs start. */ XXXXXX = &tmpl[len - 6]; value += (PlULong) time(NULL) ^ getpid(); for (count = 0; count < TMP_MAX; value += 7777, ++count) { PlULong v = value; /* Fill in the random bits. */ XXXXXX[0] = letters[v % 62]; v /= 62; XXXXXX[1] = letters[v % 62]; v /= 62; XXXXXX[2] = letters[v % 62]; v /= 62; XXXXXX[3] = letters[v % 62]; v /= 62; XXXXXX[4] = letters[v % 62]; v /= 62; XXXXXX[5] = letters[v % 62]; if (lstat(tmpl, &buf) < 0) { if (errno == ENOENT) { errno = 0; return tmpl; } else /* Give up now. */ return NULL; } } /* We got out of the loop because we ran out of combinations to try. */ errno = EEXIST; return NULL; #else errno = 0; return mktemp(tmpl); #endif } /*-------------------------------------------------------------------------* * PL_M_TEMPNAM * * * *-------------------------------------------------------------------------*/ char * Pl_M_Tempnam(char *dir, char *pfx) { #if defined(__unix__) || defined(__CYGWIN__) /* this code comes from glibc */ char tmpl[MAXPATHLEN]; char *d; int dlen, plen; struct stat buf; #ifndef P_tmpdir #define P_tmpdir "/tmp" #endif #define Dir_Exists(dir) (stat(dir, &buf) == 0 && S_ISDIR (buf.st_mode)) if (!pfx || !pfx[0]) { pfx = "file"; plen = 4; } else { plen = strlen(pfx); if (plen > 5) plen = 5; } d = getenv("TMPDIR"); if (d != NULL && Dir_Exists(d)) dir = d; else if (dir != NULL && Dir_Exists(dir)) /* nothing */ ; else dir = NULL; if (dir == NULL) { if (Dir_Exists(P_tmpdir)) dir = P_tmpdir; else if (strcmp(P_tmpdir, "/tmp") != 0 && Dir_Exists("/tmp")) dir = "/tmp"; else { errno = ENOENT; return NULL; } } dlen = strlen(dir); while (dlen > 1 && dir[dlen - 1] == '/') dlen--; /* remove trailing slashes */ /* check we have room for "${dir}/${pfx}XXXXXX\0" */ if (MAXPATHLEN < dlen + 1 + plen + 6 + 1) { errno = EINVAL; return NULL; } sprintf(tmpl, "%.*s/%.*sXXXXXX", dlen, dir, plen, pfx); d = Pl_M_Mktemp(tmpl); if (d) d = strdup(d); return d; #else errno = 0; if (dir == NULL && getenv("TMP") == NULL) /* under Win32, _tempnam checks TMP */ dir = "./"; return tempnam(dir, pfx); #endif } #ifdef USE_ALONE /*-------------------------------------------------------------------------* * MAIN * * * * to compile alone active USE_ALONE and simply compile this file. * * Under Win32 to also test with the GUI Console active USE_W32_GUI_CONSOLE* * and compile with gplc machine1.c or gplc machine1.c --gui-console * * WIN32 WARNING: it seems that the executable file name must be at least 2* * characters long (e.g. x.exe is not OK but xx.exe yes). * *-------------------------------------------------------------------------*/ #if defined(__unix__) || defined(__CYGWIN__) #define PREFIX_DIR #else #define PREFIX_DIR "c:\\cygwin\\bin\\" #endif #define READ(str, f) \ { \ char buff[1024]; \ \ DBGPRINTF("\n Reading redirected %s\n", str); \ while (fgets(buff, sizeof(buff), f)) \ { \ if (buff[strlen(buff) - 1] == '\n') \ buff[strlen(buff) - 1] = '\0'; \ DBGPRINTF(" <%s>\n", buff); \ if (feof(f)) \ break; \ } \ fclose(f); \ DBGPRINTF(" End reading redirected %s\n", str); \ } #define CHECK(pid) \ { \ if (pid == -1) \ { \ DBGPRINTF(" ERROR executing Spawn: errno=%d\n", errno); \ exit(1); \ } \ if (pid == -2) \ { \ DBGPRINTF("ERROR executing Spawn: unknown error\n"); \ exit(1); \ } \ DBGPRINTF(" pid=%d (%x)\n", pid, pid); \ } #define STAT(pid) \ { \ int status = Pl_M_Get_Status(pid); \ STATUS(status) \ } #define STATUS(status) \ { \ DBGPRINTF(" status=%d", status); \ if (status == -1) \ DBGPRINTF(" errno=%d", errno); \ DBGPRINTF("\n\n"); \ } #if 1 #define COMMAND \ strcpy(buff, PREFIX_DIR "bc --q"); /* should be modifiable */ \ arg[0] = buff; \ arg[1] = (char *) 1; #else #define COMMAND arg[0]=PREFIX_DIR "bc"; \ arg[1]="-q"; \ arg[2]=NULL; #endif #define CDE_STRING "1+255\n$foo\n2^10\nquit\n" #define CDE_INPUT fprintf(i, CDE_STRING); fclose(i); #if 0 #define POLL #include <sys/poll.h> #endif #ifdef POLL { int fd = fileno(i); struct pollfd ufd = { fd, 7, 0 }; int r = poll(&ufd, 1, 100); DBGPRINTF("poll ret:%d on fd %d returned events :%x\n", r, fd, ufd.revents); return 0; } #endif int main(int argc, char *argv[]) { FILE *i, *o, *e; int pid, status; char *arg[10]; char buff[256]; Pl_Init_Machine1(); printf("OS used:%s\n", pl_m_os_version); #if defined(_MSC_VER) setbuf(stdout, NULL); setbuf(stderr, NULL); #endif #ifdef USE_W32_GUI_CONSOLE { char buff[100]; DBGPRINTF("HELLO World\n"); Pl_LE_Gets(buff); } #endif #if 1 if (argc > 1) { DBGPRINTF("1- Executing from argv[1]...=%s... no redirect\n", argv[1]); pid = Pl_M_Spawn_Redirect(argv + 1, 0, NULL, NULL, NULL); CHECK(pid); STAT(pid); DBGPRINTF("1b- Executing from argv[1]...=%s... Spawn\n", argv[1]); status = Pl_M_Spawn(argv + 1); STATUS(status); } else DBGPRINTF("1- Executing from argv[1] - ignored\n"); #endif #if 1 DBGPRINTF("2- Executing uname -a with redirected output\n"); strcpy(buff, PREFIX_DIR "uname -a"); /* should be modifiable */ arg[0] = buff; arg[1] = (char *) 1; pid = Pl_M_Spawn_Redirect(arg, 0, NULL, &o, NULL); CHECK(pid); READ("output", o); STAT(pid); #endif COMMAND; DBGPRINTF("Command is: %s with following input:\n" CDE_STRING, arg[0]); DBGPRINTF("--- end of input\n"); #if 1 DBGPRINTF("3- command with redirected input\n"); COMMAND; pid = Pl_M_Spawn_Redirect(arg, 0, &i, NULL, NULL); CHECK(pid); CDE_INPUT; STAT(pid); #endif #if 1 DBGPRINTF("4- command with redirected input and output\n"); COMMAND; pid = Pl_M_Spawn_Redirect(arg, 0, &i, &o, NULL); CHECK(pid); CDE_INPUT; READ("output", o); STAT(pid); #endif #if 1 DBGPRINTF("5- command with redirected input output and error\n"); COMMAND; pid = Pl_M_Spawn_Redirect(arg, 0, &i, &o, &e); CHECK(pid); CDE_INPUT; READ("output", o); READ("error", e); STAT(pid); #endif #if 1 DBGPRINTF("6- command with redirected input and output=error\n"); COMMAND; pid = Pl_M_Spawn_Redirect(arg, 0, &i, &o, &o); CHECK(pid); CDE_INPUT; READ("output/error", o); STAT(pid); #endif #ifdef USE_W32_GUI_CONSOLE { /* for W32GUICons */ char buff[100]; DBGPRINTF("Terminated - press ENTER\n"); Pl_LE_Gets(buff); } #endif return 0; } #endif /* USE_ALONE */ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/try_sigaction.c����������������������������������������������������������0000644�0001750�0001750�00000007161�13021324543�016636� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : configuration * * File : try_sigaction.c * * Descr.: Detection of working sigaction * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define _XOPEN_SOURCE 700 /* #define _GNU_SOURCE */ /* see /usr/include/features.h */ #define _XOPEN_SOURCE_EXTENDED #include <stdio.h> #include <stdlib.h> #include <signal.h> #include <unistd.h> /*#include <sys/siginfo.h>*/ /* chose an address ending by 0 (else can trigger a SIGBUS, and on some archs (sparc/OpenBSD) * si_addr is wrong for SIGBUS :-( */ #define BAD_ADDR ((int *) 0x2EA4F0) void SIGSEGV_Handler(int sig, siginfo_t * sip) { int *addr = (int *) sip->si_addr; #if 0 printf("bad addr: %p\n", addr); #endif _exit(addr != BAD_ADDR); } int main(int argc, char *argv[]) { struct sigaction act; act.sa_handler = NULL; act.sa_sigaction = (void (*)()) SIGSEGV_Handler; sigemptyset(&act.sa_mask); act.sa_flags = SA_SIGINFO | SA_RESTART; sigaction(SIGSEGV, &act, NULL); #if defined(SIGBUS) && SIGBUS != SIGSEGV sigaction(SIGBUS, &act, NULL); #endif *BAD_ADDR = 128; return 1; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/pred.h�������������������������������������������������������������������0000644�0001750�0001750�00000013600�13021324543�014712� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : pred.h * * Descr.: module/predicate table management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /* if modified -> modif wam2ma.c */ #define MASK_PRED_NATIVE_CODE 1 /* codep is set, except for control constructs */ #define MASK_PRED_DYNAMIC 2 /* dynamic or static */ #define MASK_PRED_PUBLIC 4 /* public or private */ #define MASK_PRED_BUILTIN 8 /* built-in (procedure provided by the system) */ #define MASK_PRED_BUILTIN_FD 16 /* FD built-in pred (==> MASK_PRED_BUILTIN) */ #define MASK_PRED_CONTROL_CONSTRUCT 32 /* control_construct (==> MASK_PRED_BUILTIN) */ #define MASK_PRED_MULTIFILE 64 /* multifile or monofile */ #define MASK_PRED_EXPORTED 128 /* exported by module */ #define MASK_PRED_META_PRED 256 /* has a meta_predicate declaration (see macros) */ /* Each meta_predicate arg specif is coded on 4 bits (0..10 are for integ) */ #define META_PRED_ARG_COLON 11 /* meta spec : (meta) */ #define META_PRED_ARG_PLUS 12 /* meta spec + (nonvar) */ #define META_PRED_ARG_MINUS 13 /* meta spec - (var) */ #define META_PRED_ARG_QUESTION 14 /* meta spec ? (any term) */ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef uint64_t MetaSpec; /* 4-bits/arg for meta_pred spec */ typedef struct /* Module information */ { /* ------------------------------ */ long module; /* key is the atom module */ int pl_file; /* atom pl file of its definiton */ char *pred_tbl; /* predicate table of the module */ } ModuleInf; typedef struct /* Predicate information */ { /* ------------------------------ */ PlLong f_n; /* key is <functor_atom,arity> */ ModuleInf *mod; /* associated module (back link) */ int pl_file; /* atom pl file of its definiton */ int pl_line; /* pl file line of its definition */ int prop; /* predicate props (cf BipsPl) */ MetaSpec meta_spec; /* meta_predicate specifier */ CodePtr codep; /* compiled code */ PlLong *dyn; /* dynamic info (cf BipsPl) */ } PredInf; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef PRED_FILE char *pl_module_tbl; #else extern char *pl_module_tbl; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Init_Pred(void); ModuleInf *Pl_Create_Module(int module, int pl_file); ModuleInf *Pl_Lookup_Module(int module); void Pl_Delete_Module(int module); void Pl_Create_Pred_Table(void); PredInf * FC Pl_Create_Pred(int module, int func, int arity, int pl_file, int pl_line, int prop, CodePtr codep); PredInf *Pl_Create_Pred_Meta(int module, int func, int arity, int pl_file, int pl_line, int prop, CodePtr codep, int meta_arg[]); PredInf *Pl_Lookup_Pred(int module, int func, int arity); PredInf *Pl_Lookup_Pred_Visible(int module, int func, int arity); PredInf *Pl_Check_Sys_Pred_Exist(char *name, int arity); void Pl_Delete_Pred(int module, int func, int arity); ��������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/euclide.c����������������������������������������������������������������0000644�0001750�0001750�00000013365�13021324543�015375� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : development tool * * File : euclide.c * * Descr.: compute inverse * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> /*-------------------------------------------------------------------------* * This program takes 2 numbers N1 and N2 (relatively prime) and computes * * N3 s.t. N1*N3 % N2 = 1. * * It uses the Euclide algorithm, by successive divisions of n1 by n2 until* * n2==0 maintaining u1 v1 and u2 v2 s.t., at each step, we have * * * * n1=u1*N1 + v1*N2 * * n2=u2*N1 + v2*N2 * * * * At the end, n2=0, n1 is the gdb of N1 and N2 and u1 is the wanted nb. * * * * This program is used to compute the constant INV_RADIX_MOD_MAX_ATOM in * * atom.c. Indeed, it is the result of euclide RADIX MAX_ATOM, ie. actually* * RADIX=67 and MAX_ATOM=65536 thus INV_RADIX_MOD_MAX_ATOM=19563. * * If MAX_ATOM is changed, INV_RADIX_MOD_MAX_ATOM must be changed too. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * EUCLIDE * * * *-------------------------------------------------------------------------*/ unsigned Euclide(unsigned N1, unsigned N2) { unsigned q, r; int u2, v2; int u1, v1; int t; unsigned n1 = N1; unsigned n2 = N2; /* v1 and v2 are not used actually */ u1 = 1; v1 = 0; u2 = 0; v2 = 1; while (n2) { q = n1 / n2; /* gcd part */ r = n1 % n2; n1 = n2; n2 = r; t = u1 - q * u2; /* maintaining u1 and u2 */ u1 = u2; u2 = t; t = v1 - q * v2; /* maintaining v1 and v2 */ v1 = v2; v2 = t; } if (u1 < 0) u1 += N2; return u1; } /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { unsigned n1; unsigned n2; unsigned inv_n1_mod_n2; if (argc != 3) { printf("Usage: %s nb_to_invert modulo\n", argv[0]); printf(" nb_to_invert and modulo must be relatively prime\n"); return 1; } n1 = atoi(argv[1]); n2 = atoi(argv[2]); inv_n1_mod_n2 = Euclide(n1, n2); printf("Res: %-10u i.e. (1/%u) %% %u = %u\n", inv_n1_mod_n2, n1, n2, inv_n1_mod_n2); printf(" %-10s i.e. (%u*%u) %% %u = 1\n", "", n1, inv_n1_mod_n2, n2); if ((unsigned) ((n1 * inv_n1_mod_n2) % n2) != 1) printf("\n*** CHECK ERROR %u instead of 1\n", (n1 * inv_n1_mod_n2) % n2); return 0; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/engine.h�����������������������������������������������������������������0000644�0001750�0001750�00000011001�13021324543�015216� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : engine.h * * Descr.: general engine - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifdef NO_STACK_TEST # undef M_Check_Stacks() # define M_Check_Stacks() #endif /*---------------------------------* * Constants * *---------------------------------*/ #define cpp_recurs(p, n) p##__a##n #define Prolog_Predicate(p, n) cpp_recurs(p, n) #define Prolog_Prototype(p, n) void Prolog_Predicate(p, n)() /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef ENGINE_FILE int pl_os_argc; char **pl_os_argv; char *pl_home; int pl_devel_mode; char pl_glob_buff[10240]; PlLong *pl_base_fl; /* overwritten by foreign if present */ double *pl_base_fd; /* overwritten by foreign if present */ int pl_le_mode; /* LE_MODE_HOOK if GUI */ #else extern int pl_os_argc; extern char **pl_os_argv; extern char *pl_home; extern int pl_devel_mode; extern char pl_glob_buff[]; extern PlLong *pl_base_fl; extern double *pl_base_fd; extern int pl_le_mode; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Pl_Start_Prolog(int argc, char *argv[]); void Pl_Stop_Prolog(void); void Pl_Reset_Prolog(void); void Pl_Reset_Prolog_In_Signal(void); void Pl_Set_Heap_Actual_Start(WamWord *heap_actual_start); void Pl_Execute_Directive(int pl_file, int pl_line, Bool is_system, CodePtr proc); Bool Pl_Try_Execute_Top_Level(void); Bool Pl_Call_Prolog(CodePtr codep); Bool Pl_Call_Prolog_Next_Sol(WamWord *query_b); void Pl_Keep_Rest_For_Prolog(WamWord *query_b); void Pl_Exit_With_Exception(void); void Pl_Execute_A_Continuation(CodePtr codep); #define Goto_Predicate(p, n) ((*Prolog_Predicate(p, n))()) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/engine_pl.h��������������������������������������������������������������0000644�0001750�0001750�00000006122�13021324543�015721� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : engine_pl.h * * Descr.: general header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "gp_config.h" #include "pl_params.h" #include "hash_fct.h" #include "hash.h" #include "bool.h" #include "wam_regs.h" #include "wam_archi.h" #include "engine.h" #include "atom.h" #include "pred.h" #include "misc.h" #include "oper.h" #include "machine1.h" #include "machine.h" #include "stacks_sigsegv.h" #include "obj_chain.h" #include "wam_inst.h" #include "if_no_fd.h" ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/cpp_headers.c������������������������������������������������������������0000644�0001750�0001750�00000015256�13021324543�016241� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : installation * * File : cpp_headers.c * * Descr.: General GNU Prolog header file maker * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <ctype.h> #include "gp_config.h" #if 1 #define DO_NOT_ADD_COMMENTS #endif #if 0 #define REMOVE_COMMENTS #endif #if 0 #define REMOVE_BLANK_LINES #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { char *name; char *parent; int line; } UsedFile; /*---------------------------------* * Global Variables * *---------------------------------*/ char **dir; FILE *fout; char buff[4096]; UsedFile used[1024]; int nb_used = 0; /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Cpp_File(char *name, int skip_comment); /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { if (argc < 4) { fprintf(stderr, "Usage cpp_headers in_file.h out_file.h search_dir...\n"); return 1; } dir = argv + 3; if ((fout = fopen(argv[2], "w")) == NULL) { perror(argv[2]); return 1; } #ifndef DO_NOT_ADD_COMMENTS fprintf(fout, "/* %s generated from %s using cpp_headers */\n", argv[2], argv[1]); #endif Cpp_File(argv[1], 0); fclose(fout); return 0; } #define SKIP_SPACE(p) while(isspace(*p)) p++; /*-------------------------------------------------------------------------* * CPP_FILE * * * *-------------------------------------------------------------------------*/ void Cpp_File(char *name, int skip_comment) { char **d; int i; FILE *fin; char *p, *q; int line = 0; char name1[1024]; #ifdef REMOVE_COMMENTS int inside_comment = 0; #endif #ifdef REMOVE_BLANK_LINES int can_be_removed = 1; #endif for (d = dir; *d; d++) { sprintf(buff, "%s/%s", *d, name); if ((fin = fopen(buff, "r")) != NULL) break; } if (*d == NULL) { fprintf(stderr, "Cannot find the location of %s\n", name); exit(1); } while (fgets(buff, sizeof(buff), fin)) { line++; #ifdef REMOVE_COMMENTS if (skip_comment) { if (!inside_comment) { for(p = buff; isspace(*p); p++) ; if (*p == '/' && p[1] == '*') { if (strstr(p, "*/") == NULL) inside_comment = 1; continue; } } else { if (strstr(p, "*/") != NULL) inside_comment = 0; continue; } } #endif if (*buff != '#') goto reflect_line; p = buff + 1; SKIP_SPACE(p); if (strncmp(p, "include", 7)) goto reflect_line; p += 7; SKIP_SPACE(p); if (*p != '"') goto reflect_line; p++; q = p + strlen(p); while (*q != '"') q--; *q = '\0'; strcpy(name1, p); #ifndef DO_NOT_ADD_COMMENTS fprintf(fout, "/* %s:%d includes %s */\n", name, line, name1); #endif for (i = 0; i < nb_used; i++) if (strcmp(used[i].name, name1) == 0) break; if (i >= nb_used) { used[nb_used].name = strdup(name1); used[nb_used].parent = strdup(name); used[nb_used].line = line; nb_used++; Cpp_File(name1, 1); } #ifndef DO_NOT_ADD_COMMENTS else fprintf(fout, "/* already included by %s:%d */\n", used[i].parent, used[i].line); #endif continue; reflect_line: #ifdef REMOVE_BLANK_LINES if (can_be_removed) { p = buff; SKIP_SPACE(p); if (*p == '\0') continue; } p = buff + strlen(buff) - 1; while (isspace(*p)) p--; can_be_removed = (*p != '\\'); #endif fputs(buff, fout); } fclose(fin); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/test_oc_defs.h�����������������������������������������������������������0000644�0001750�0001750�00000001647�13021324543�016431� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #define OBJ_INIT Init_Tables #include "obj_chain.h" static char name[32]; int count; int mask; int errors; int no; int inc; static void Init_Tables() { if (no == 0) /* first object initialization */ { if (OBJ_NO == 1) { printf("WARNING: it seems objects are initialized from first to last\n"); printf(" better is from last to first, for this:\n " #ifdef OBJ_CHAIN_REVERSE_ORDER "un" #endif "define constant OBJ_CHAIN_REVERSE_ORDER in obj_chain.h\n"); // errors++; inc = 1; } else inc = -1; } else { if (OBJ_NO != no + inc) { printf("warning: object %d found while expecting object %d - it seems order of objects is not predictible\n", OBJ_NO, no); errors++; } } no = OBJ_NO; count++; mask |= (1 << no); sprintf(name, "object #%d", OBJ_NO); printf("object <%s> found &name:%p\n", name, &name); } �����������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/main.c�������������������������������������������������������������������0000644�0001750�0001750�00000012425�13021324543�014703� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : main.c * * Descr.: main * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include "engine_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * MAIN * * * * A problem appeared in GCC 3.0.x under Linux/ix86: * * the main() function always use a frame (and thus ebp). This causes a bug* * if ebp is used by gcc between Pl_Start_Prolog() and Pl_Stop_Prolog() * * (e.g. to access argv/argc or local variables) since ebp contains a WAM * * register. Note that after Pl_Stop_Prolog() all registers are restored * * and ebp is correct when returning in main(). * * * * To solve we can use an intermediate function Main_Wrapper() called by * * the main() function. * * * * Another solution consists in passing -mpreferred-stack-boundary=2 to gcc* * since it gcc uses ebp to ensure the stack alignment (to 4). * * * * This main function uses the wrapper even if ebp is not really used * * between Pl_Start_Prolog() and Pl_Stop_Prolog() but to serve as model. * *-------------------------------------------------------------------------*/ static int Main_Wrapper(int argc, char *argv[]) { int nb_user_directive; Bool top_level; nb_user_directive = Pl_Start_Prolog(argc, argv); top_level = Pl_Try_Execute_Top_Level(); Pl_Stop_Prolog(); if (top_level || nb_user_directive) return 0; fprintf(stderr, "Warning: no initial goal executed\n" " use a directive :- initialization(Goal)\n" " or remove the link option --no-top-level" " (or --min-bips or --min-size)\n"); return 1; } int main(int argc, char *argv[]) { Pl_Exit_With_Value(Main_Wrapper(argc, argv)); return 0; /* anything for the compiler */ } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/test_oc.c����������������������������������������������������������������0000644�0001750�0001750�00000001245�13021324543�015415� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #include "obj_chain.h" int count; int mask; int errors; void Pl_Fatal_Error(char *msg) { fprintf(stderr, "%s\n", msg); exit(1); } int main() { int i; #ifdef _MSC_VER setbuf(stdout, NULL); setbuf(stderr, NULL); #endif printf("Obj_chain tests started...\n"); Pl_Find_Linked_Objects(); printf("%d objects found\n", count); for(i = 1; i <= count; i++) if ((mask & (1 << i)) == 0) { printf("error: object %d is not initialized\n", i); errors++; } if (errors == 0) printf("Obj_chain tests succeded\n"); else printf("Obj_chain tests failed: %d errors\n", errors); return (errors != 0); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/dl_malloc.c��������������������������������������������������������������0000644�0001750�0001750�00000655654�13021324543�015726� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/* This is a version (aka dlmalloc) of malloc/free/realloc written by Doug Lea and released to the public domain, as explained at http://creativecommons.org/publicdomain/zero/1.0/ Send questions, comments, complaints, performance data, etc to dl@cs.oswego.edu * Version 2.8.5 Sun May 22 10:26:02 2011 Doug Lea (dl at gee) Note: There may be an updated version of this malloc obtainable at ftp://gee.cs.oswego.edu/pub/misc/malloc.c Check before installing! * Quickstart This library is all in one file to simplify the most common usage: ftp it, compile it (-O3), and link it into another program. All of the compile-time options default to reasonable values for use on most platforms. You might later want to step through various compile-time and dynamic tuning options. For convenience, an include file for code using this malloc is at: ftp://gee.cs.oswego.edu/pub/misc/malloc-2.8.5.h You don't really need this .h file unless you call functions not defined in your system include files. The .h file contains only the excerpts from this file needed for using this malloc on ANSI C/C++ systems, so long as you haven't changed compile-time options about naming and tuning parameters. If you do, then you can create your own malloc.h that does include all settings by cutting at the point indicated below. Note that you may already by default be using a C library containing a malloc that is based on some version of this malloc (for example in linux). You might still want to use the one in this file to customize settings or to avoid overheads associated with library versions. * Vital statistics: Supported pointer/size_t representation: 4 or 8 bytes size_t MUST be an unsigned type of the same width as pointers. (If you are using an ancient system that declares size_t as a signed type, or need it to be a different width than pointers, you can use a previous release of this malloc (e.g. 2.7.2) supporting these.) Alignment: 8 bytes (default) This suffices for nearly all current machines and C compilers. However, you can define MALLOC_ALIGNMENT to be wider than this if necessary (up to 128bytes), at the expense of using more space. Minimum overhead per allocated chunk: 4 or 8 bytes (if 4byte sizes) 8 or 16 bytes (if 8byte sizes) Each malloced chunk has a hidden word of overhead holding size and status information, and additional cross-check word if FOOTERS is defined. Minimum allocated size: 4-byte ptrs: 16 bytes (including overhead) 8-byte ptrs: 32 bytes (including overhead) Even a request for zero bytes (i.e., malloc(0)) returns a pointer to something of the minimum allocatable size. The maximum overhead wastage (i.e., number of extra bytes allocated than were requested in malloc) is less than or equal to the minimum size, except for requests >= mmap_threshold that are serviced via mmap(), where the worst case wastage is about 32 bytes plus the remainder from a system page (the minimal mmap unit); typically 4096 or 8192 bytes. Security: static-safe; optionally more or less The "security" of malloc refers to the ability of malicious code to accentuate the effects of errors (for example, freeing space that is not currently malloc'ed or overwriting past the ends of chunks) in code that calls malloc. This malloc guarantees not to modify any memory locations below the base of heap, i.e., static variables, even in the presence of usage errors. The routines additionally detect most improper frees and reallocs. All this holds as long as the static bookkeeping for malloc itself is not corrupted by some other means. This is only one aspect of security -- these checks do not, and cannot, detect all possible programming errors. If FOOTERS is defined nonzero, then each allocated chunk carries an additional check word to verify that it was malloced from its space. These check words are the same within each execution of a program using malloc, but differ across executions, so externally crafted fake chunks cannot be freed. This improves security by rejecting frees/reallocs that could corrupt heap memory, in addition to the checks preventing writes to statics that are always on. This may further improve security at the expense of time and space overhead. (Note that FOOTERS may also be worth using with MSPACES.) By default detected errors cause the program to abort (calling "abort()"). You can override this to instead proceed past errors by defining PROCEED_ON_ERROR. In this case, a bad free has no effect, and a malloc that encounters a bad address caused by user overwrites will ignore the bad address by dropping pointers and indices to all known memory. This may be appropriate for programs that should continue if at all possible in the face of programming errors, although they may run out of memory because dropped memory is never reclaimed. If you don't like either of these options, you can define CORRUPTION_ERROR_ACTION and USAGE_ERROR_ACTION to do anything else. And if if you are sure that your program using malloc has no errors or vulnerabilities, you can define INSECURE to 1, which might (or might not) provide a small performance improvement. It is also possible to limit the maximum total allocatable space, using malloc_set_footprint_limit. This is not designed as a security feature in itself (calls to set limits are not screened or privileged), but may be useful as one aspect of a secure implementation. Thread-safety: NOT thread-safe unless USE_LOCKS defined non-zero When USE_LOCKS is defined, each public call to malloc, free, etc is surrounded with a lock. By default, this uses a plain pthread mutex, win32 critical section, or a spin-lock if if available for the platform and not disabled by setting USE_SPIN_LOCKS=0. However, if USE_RECURSIVE_LOCKS is defined, recursive versions are used instead (which are not required for base functionality but may be needed in layered extensions). Using a global lock is not especially fast, and can be a major bottleneck. It is designed only to provide minimal protection in concurrent environments, and to provide a basis for extensions. If you are using malloc in a concurrent program, consider instead using nedmalloc (http://www.nedprod.com/programs/portable/nedmalloc/) or ptmalloc (See http://www.malloc.de), which are derived from versions of this malloc. System requirements: Any combination of MORECORE and/or MMAP/MUNMAP This malloc can use unix sbrk or any emulation (invoked using the CALL_MORECORE macro) and/or mmap/munmap or any emulation (invoked using CALL_MMAP/CALL_MUNMAP) to get and release system memory. On most unix systems, it tends to work best if both MORECORE and MMAP are enabled. On Win32, it uses emulations based on VirtualAlloc. It also uses common C library functions like memset. Compliance: I believe it is compliant with the Single Unix Specification (See http://www.unix.org). Also SVID/XPG, ANSI C, and probably others as well. * Overview of algorithms This is not the fastest, most space-conserving, most portable, or most tunable malloc ever written. However it is among the fastest while also being among the most space-conserving, portable and tunable. Consistent balance across these factors results in a good general-purpose allocator for malloc-intensive programs. In most ways, this malloc is a best-fit allocator. Generally, it chooses the best-fitting existing chunk for a request, with ties broken in approximately least-recently-used order. (This strategy normally maintains low fragmentation.) However, for requests less than 256bytes, it deviates from best-fit when there is not an exactly fitting available chunk by preferring to use space adjacent to that used for the previous small request, as well as by breaking ties in approximately most-recently-used order. (These enhance locality of series of small allocations.) And for very large requests (>= 256Kb by default), it relies on system memory mapping facilities, if supported. (This helps avoid carrying around and possibly fragmenting memory used only for large chunks.) All operations (except malloc_stats and mallinfo) have execution times that are bounded by a constant factor of the number of bits in a size_t, not counting any clearing in calloc or copying in realloc, or actions surrounding MORECORE and MMAP that have times proportional to the number of non-contiguous regions returned by system allocation routines, which is often just 1. In real-time applications, you can optionally suppress segment traversals using NO_SEGMENT_TRAVERSAL, which assures bounded execution even when system allocators return non-contiguous spaces, at the typical expense of carrying around more memory and increased fragmentation. The implementation is not very modular and seriously overuses macros. Perhaps someday all C compilers will do as good a job inlining modular code as can now be done by brute-force expansion, but now, enough of them seem not to. Some compilers issue a lot of warnings about code that is dead/unreachable only on some platforms, and also about intentional uses of negation on unsigned types. All known cases of each can be ignored. For a longer but out of date high-level description, see http://gee.cs.oswego.edu/dl/html/malloc.html * MSPACES If MSPACES is defined, then in addition to malloc, free, etc., this file also defines mspace_malloc, mspace_free, etc. These are versions of malloc routines that take an "mspace" argument obtained using create_mspace, to control all internal bookkeeping. If ONLY_MSPACES is defined, only these versions are compiled. So if you would like to use this allocator for only some allocations, and your system malloc for others, you can compile with ONLY_MSPACES and then do something like... static mspace mymspace = create_mspace(0,0); // for example #define mymalloc(bytes) mspace_malloc(mymspace, bytes) (Note: If you only need one instance of an mspace, you can instead use "USE_DL_PREFIX" to relabel the global malloc.) You can similarly create thread-local allocators by storing mspaces as thread-locals. For example: static __thread mspace tlms = 0; void* tlmalloc(size_t bytes) { if (tlms == 0) tlms = create_mspace(0, 0); return mspace_malloc(tlms, bytes); } void tlfree(void* mem) { mspace_free(tlms, mem); } Unless FOOTERS is defined, each mspace is completely independent. You cannot allocate from one and free to another (although conformance is only weakly checked, so usage errors are not always caught). If FOOTERS is defined, then each chunk carries around a tag indicating its originating mspace, and frees are directed to their originating spaces. Normally, this requires use of locks. ------------------------- Compile-time options --------------------------- Be careful in setting #define values for numerical constants of type size_t. On some systems, literal values are not automatically extended to size_t precision unless they are explicitly casted. You can also use the symbolic values MAX_SIZE_T, SIZE_T_ONE, etc below. WIN32 default: defined if _WIN32 defined Defining WIN32 sets up defaults for MS environment and compilers. Otherwise defaults are for unix. Beware that there seem to be some cases where this malloc might not be a pure drop-in replacement for Win32 malloc: Random-looking failures from Win32 GDI API's (eg; SetDIBits()) may be due to bugs in some video driver implementations when pixel buffers are malloc()ed, and the region spans more than one VirtualAlloc()ed region. Because dlmalloc uses a small (64Kb) default granularity, pixel buffers may straddle virtual allocation regions more often than when using the Microsoft allocator. You can avoid this by using VirtualAlloc() and VirtualFree() for all pixel buffers rather than using malloc(). If this is not possible, recompile this malloc with a larger DEFAULT_GRANULARITY. Note: in cases where MSC and gcc (cygwin) are known to differ on WIN32, conditions use _MSC_VER to distinguish them. DLMALLOC_EXPORT default: extern Defines how public APIs are declared. If you want to export via a Windows DLL, you might define this as #define DLMALLOC_EXPORT extern __declspace(dllexport) If you want a POSIX ELF shared object, you might use #define DLMALLOC_EXPORT extern __attribute__((visibility("default"))) MALLOC_ALIGNMENT default: (size_t)8 Controls the minimum alignment for malloc'ed chunks. It must be a power of two and at least 8, even on machines for which smaller alignments would suffice. It may be defined as larger than this though. Note however that code and data structures are optimized for the case of 8-byte alignment. MSPACES default: 0 (false) If true, compile in support for independent allocation spaces. This is only supported if HAVE_MMAP is true. ONLY_MSPACES default: 0 (false) If true, only compile in mspace versions, not regular versions. USE_LOCKS default: 0 (false) Causes each call to each public routine to be surrounded with pthread or WIN32 mutex lock/unlock. (If set true, this can be overridden on a per-mspace basis for mspace versions.) If set to a non-zero value other than 1, locks are used, but their implementation is left out, so lock functions must be supplied manually, as described below. USE_SPIN_LOCKS default: 1 iff USE_LOCKS and spin locks available If true, uses custom spin locks for locking. This is currently supported only gcc >= 4.1, older gccs on x86 platforms, and recent MS compilers. Otherwise, posix locks or win32 critical sections are used. USE_RECURSIVE_LOCKS default: not defined If defined nonzero, uses recursive (aka reentrant) locks, otherwise uses plain mutexes. This is not required for malloc proper, but may be needed for layered allocators such as nedmalloc. FOOTERS default: 0 If true, provide extra checking and dispatching by placing information in the footers of allocated chunks. This adds space and time overhead. INSECURE default: 0 If true, omit checks for usage errors and heap space overwrites. USE_DL_PREFIX default: NOT defined Causes compiler to prefix all public routines with the string 'dl'. This can be useful when you only want to use this malloc in one part of a program, using your regular system malloc elsewhere. MALLOC_INSPECT_ALL default: NOT defined If defined, compiles malloc_inspect_all and mspace_inspect_all, that perform traversal of all heap space. Unless access to these functions is otherwise restricted, you probably do not want to include them in secure implementations. ABORT default: defined as abort() Defines how to abort on failed checks. On most systems, a failed check cannot die with an "assert" or even print an informative message, because the underlying print routines in turn call malloc, which will fail again. Generally, the best policy is to simply call abort(). It's not very useful to do more than this because many errors due to overwriting will show up as address faults (null, odd addresses etc) rather than malloc-triggered checks, so will also abort. Also, most compilers know that abort() does not return, so can better optimize code conditionally calling it. PROCEED_ON_ERROR default: defined as 0 (false) Controls whether detected bad addresses cause them to bypassed rather than aborting. If set, detected bad arguments to free and realloc are ignored. And all bookkeeping information is zeroed out upon a detected overwrite of freed heap space, thus losing the ability to ever return it from malloc again, but enabling the application to proceed. If PROCEED_ON_ERROR is defined, the static variable malloc_corruption_error_count is compiled in and can be examined to see if errors have occurred. This option generates slower code than the default abort policy. DEBUG default: NOT defined The DEBUG setting is mainly intended for people trying to modify this code or diagnose problems when porting to new platforms. However, it may also be able to better isolate user errors than just using runtime checks. The assertions in the check routines spell out in more detail the assumptions and invariants underlying the algorithms. The checking is fairly extensive, and will slow down execution noticeably. Calling malloc_stats or mallinfo with DEBUG set will attempt to check every non-mmapped allocated and free chunk in the course of computing the summaries. ABORT_ON_ASSERT_FAILURE default: defined as 1 (true) Debugging assertion failures can be nearly impossible if your version of the assert macro causes malloc to be called, which will lead to a cascade of further failures, blowing the runtime stack. ABORT_ON_ASSERT_FAILURE cause assertions failures to call abort(), which will usually make debugging easier. MALLOC_FAILURE_ACTION default: sets errno to ENOMEM, or no-op on win32 The action to take before "return 0" when malloc fails to be able to return memory because there is none available. HAVE_MORECORE default: 1 (true) unless win32 or ONLY_MSPACES True if this system supports sbrk or an emulation of it. MORECORE default: sbrk The name of the sbrk-style system routine to call to obtain more memory. See below for guidance on writing custom MORECORE functions. The type of the argument to sbrk/MORECORE varies across systems. It cannot be size_t, because it supports negative arguments, so it is normally the signed type of the same width as size_t (sometimes declared as "intptr_t"). It doesn't much matter though. Internally, we only call it with arguments less than half the max value of a size_t, which should work across all reasonable possibilities, although sometimes generating compiler warnings. MORECORE_CONTIGUOUS default: 1 (true) if HAVE_MORECORE If true, take advantage of fact that consecutive calls to MORECORE with positive arguments always return contiguous increasing addresses. This is true of unix sbrk. It does not hurt too much to set it true anyway, since malloc copes with non-contiguities. Setting it false when definitely non-contiguous saves time and possibly wasted space it would take to discover this though. MORECORE_CANNOT_TRIM default: NOT defined True if MORECORE cannot release space back to the system when given negative arguments. This is generally necessary only if you are using a hand-crafted MORECORE function that cannot handle negative arguments. NO_SEGMENT_TRAVERSAL default: 0 If non-zero, suppresses traversals of memory segments returned by either MORECORE or CALL_MMAP. This disables merging of segments that are contiguous, and selectively releasing them to the OS if unused, but bounds execution times. HAVE_MMAP default: 1 (true) True if this system supports mmap or an emulation of it. If so, and HAVE_MORECORE is not true, MMAP is used for all system allocation. If set and HAVE_MORECORE is true as well, MMAP is primarily used to directly allocate very large blocks. It is also used as a backup strategy in cases where MORECORE fails to provide space from system. Note: A single call to MUNMAP is assumed to be able to unmap memory that may have be allocated using multiple calls to MMAP, so long as they are adjacent. HAVE_MREMAP default: 1 on linux, else 0 If true realloc() uses mremap() to re-allocate large blocks and extend or shrink allocation spaces. MMAP_CLEARS default: 1 except on WINCE. True if mmap clears memory so calloc doesn't need to. This is true for standard unix mmap using /dev/zero and on WIN32 except for WINCE. USE_BUILTIN_FFS default: 0 (i.e., not used) Causes malloc to use the builtin ffs() function to compute indices. Some compilers may recognize and intrinsify ffs to be faster than the supplied C version. Also, the case of x86 using gcc is special-cased to an asm instruction, so is already as fast as it can be, and so this setting has no effect. Similarly for Win32 under recent MS compilers. (On most x86s, the asm version is only slightly faster than the C version.) malloc_getpagesize default: derive from system includes, or 4096. The system page size. To the extent possible, this malloc manages memory from the system in page-size units. This may be (and usually is) a function rather than a constant. This is ignored if WIN32, where page size is determined using getSystemInfo during initialization. USE_DEV_RANDOM default: 0 (i.e., not used) Causes malloc to use /dev/random to initialize secure magic seed for stamping footers. Otherwise, the current time is used. NO_MALLINFO default: 0 If defined, don't compile "mallinfo". This can be a simple way of dealing with mismatches between system declarations and those in this file. MALLINFO_FIELD_TYPE default: size_t The type of the fields in the mallinfo struct. This was originally defined as "int" in SVID etc, but is more usefully defined as size_t. The value is used only if HAVE_USR_INCLUDE_MALLOC_H is not set NO_MALLOC_STATS default: 0 If defined, don't compile "malloc_stats". This avoids calls to fprintf and bringing in stdio dependencies you might not want. REALLOC_ZERO_BYTES_FREES default: not defined This should be set if a call to realloc with zero bytes should be the same as a call to free. Some people think it should. Otherwise, since this malloc returns a unique pointer for malloc(0), so does realloc(p, 0). LACKS_UNISTD_H, LACKS_FCNTL_H, LACKS_SYS_PARAM_H, LACKS_SYS_MMAN_H LACKS_STRINGS_H, LACKS_STRING_H, LACKS_SYS_TYPES_H, LACKS_ERRNO_H LACKS_STDLIB_H LACKS_SCHED_H LACKS_TIME_H default: NOT defined unless on WIN32 Define these if your system does not have these header files. You might need to manually insert some of the declarations they provide. DEFAULT_GRANULARITY default: page size if MORECORE_CONTIGUOUS, system_info.dwAllocationGranularity in WIN32, otherwise 64K. Also settable using mallopt(M_GRANULARITY, x) The unit for allocating and deallocating memory from the system. On most systems with contiguous MORECORE, there is no reason to make this more than a page. However, systems with MMAP tend to either require or encourage larger granularities. You can increase this value to prevent system allocation functions to be called so often, especially if they are slow. The value must be at least one page and must be a power of two. Setting to 0 causes initialization to either page size or win32 region size. (Note: In previous versions of malloc, the equivalent of this option was called "TOP_PAD") DEFAULT_TRIM_THRESHOLD default: 2MB Also settable using mallopt(M_TRIM_THRESHOLD, x) The maximum amount of unused top-most memory to keep before releasing via malloc_trim in free(). Automatic trimming is mainly useful in long-lived programs using contiguous MORECORE. Because trimming via sbrk can be slow on some systems, and can sometimes be wasteful (in cases where programs immediately afterward allocate more large chunks) the value should be high enough so that your overall system performance would improve by releasing this much memory. As a rough guide, you might set to a value close to the average size of a process (program) running on your system. Releasing this much memory would allow such a process to run in memory. Generally, it is worth tuning trim thresholds when a program undergoes phases where several large chunks are allocated and released in ways that can reuse each other's storage, perhaps mixed with phases where there are no such chunks at all. The trim value must be greater than page size to have any useful effect. To disable trimming completely, you can set to MAX_SIZE_T. Note that the trick some people use of mallocing a huge space and then freeing it at program startup, in an attempt to reserve system memory, doesn't have the intended effect under automatic trimming, since that memory will immediately be returned to the system. DEFAULT_MMAP_THRESHOLD default: 256K Also settable using mallopt(M_MMAP_THRESHOLD, x) The request size threshold for using MMAP to directly service a request. Requests of at least this size that cannot be allocated using already-existing space will be serviced via mmap. (If enough normal freed space already exists it is used instead.) Using mmap segregates relatively large chunks of memory so that they can be individually obtained and released from the host system. A request serviced through mmap is never reused by any other request (at least not directly; the system may just so happen to remap successive requests to the same locations). Segregating space in this way has the benefits that: Mmapped space can always be individually released back to the system, which helps keep the system level memory demands of a long-lived program low. Also, mapped memory doesn't become `locked' between other chunks, as can happen with normally allocated chunks, which means that even trimming via malloc_trim would not release them. However, it has the disadvantage that the space cannot be reclaimed, consolidated, and then used to service later requests, as happens with normal chunks. The advantages of mmap nearly always outweigh disadvantages for "large" chunks, but the value of "large" may vary across systems. The default is an empirically derived value that works well in most systems. You can disable mmap by setting to MAX_SIZE_T. MAX_RELEASE_CHECK_RATE default: 4095 unless not HAVE_MMAP The number of consolidated frees between checks to release unused segments when freeing. When using non-contiguous segments, especially with multiple mspaces, checking only for topmost space doesn't always suffice to trigger trimming. To compensate for this, free() will, with a period of MAX_RELEASE_CHECK_RATE (or the current number of segments, if greater) try to release unused segments to the OS when freeing chunks that result in consolidation. The best value for this parameter is a compromise between slowing down frees with relatively costly checks that rarely trigger versus holding on to unused memory. To effectively disable, set to MAX_SIZE_T. This may lead to a very slight speed improvement at the expense of carrying around more memory. */ /* Version identifier to allow people to support multiple versions */ #ifndef DLMALLOC_VERSION #define DLMALLOC_VERSION 20805 #endif /* DLMALLOC_VERSION */ #ifndef DLMALLOC_EXPORT #define DLMALLOC_EXPORT extern #endif #ifndef WIN32 #ifdef _WIN32 #define WIN32 1 #endif /* _WIN32 */ #ifdef _WIN32_WCE #define LACKS_FCNTL_H #define WIN32 1 #endif /* _WIN32_WCE */ #endif /* WIN32 */ #ifdef WIN32 #define WIN32_LEAN_AND_MEAN #include <windows.h> #include <tchar.h> #define HAVE_MMAP 1 #define HAVE_MORECORE 0 #define LACKS_UNISTD_H #define LACKS_SYS_PARAM_H #define LACKS_SYS_MMAN_H #define LACKS_STRING_H #define LACKS_STRINGS_H #define LACKS_SYS_TYPES_H #define LACKS_ERRNO_H #define LACKS_SCHED_H #ifndef MALLOC_FAILURE_ACTION #define MALLOC_FAILURE_ACTION #endif /* MALLOC_FAILURE_ACTION */ #ifndef MMAP_CLEARS #ifdef _WIN32_WCE /* WINCE reportedly does not clear */ #define MMAP_CLEARS 0 #else #define MMAP_CLEARS 1 #endif /* _WIN32_WCE */ #endif /*MMAP_CLEARS */ #endif /* WIN32 */ #if defined(DARWIN) || defined(_DARWIN) /* Mac OSX docs advise not to use sbrk; it seems better to use mmap */ #ifndef HAVE_MORECORE #define HAVE_MORECORE 0 #define HAVE_MMAP 1 /* OSX allocators provide 16 byte alignment */ #ifndef MALLOC_ALIGNMENT #define MALLOC_ALIGNMENT ((size_t)16U) #endif #endif /* HAVE_MORECORE */ #endif /* DARWIN */ #ifndef LACKS_SYS_TYPES_H #include <sys/types.h> /* For size_t */ #endif /* LACKS_SYS_TYPES_H */ /* The maximum possible size_t value has all bits set */ #define MAX_SIZE_T (~(size_t)0) #ifndef USE_LOCKS /* ensure true if spin or recursive locks set */ #define USE_LOCKS ((defined(USE_SPIN_LOCKS) && USE_SPIN_LOCKS != 0) || \ (defined(USE_RECURSIVE_LOCKS) && USE_RECURSIVE_LOCKS != 0)) #endif /* USE_LOCKS */ #if USE_LOCKS /* Spin locks for gcc >= 4.1, older gcc on x86, MSC >= 1310 */ #if ((defined(__GNUC__) && \ ((__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1)) || \ defined(__i386__) || defined(__x86_64__))) || \ (defined(_MSC_VER) && _MSC_VER>=1310)) #ifndef USE_SPIN_LOCKS #define USE_SPIN_LOCKS 1 #endif /* USE_SPIN_LOCKS */ #elif USE_SPIN_LOCKS #error "USE_SPIN_LOCKS defined without implementation" #endif /* ... locks available... */ #elif !defined(USE_SPIN_LOCKS) #define USE_SPIN_LOCKS 0 #endif /* USE_LOCKS */ #ifndef ONLY_MSPACES #define ONLY_MSPACES 0 #endif /* ONLY_MSPACES */ #ifndef MSPACES #if ONLY_MSPACES #define MSPACES 1 #else /* ONLY_MSPACES */ #define MSPACES 0 #endif /* ONLY_MSPACES */ #endif /* MSPACES */ #ifndef MALLOC_ALIGNMENT #define MALLOC_ALIGNMENT ((size_t)8U) #endif /* MALLOC_ALIGNMENT */ #ifndef FOOTERS #define FOOTERS 0 #endif /* FOOTERS */ #ifndef ABORT #define ABORT abort() #endif /* ABORT */ #ifndef ABORT_ON_ASSERT_FAILURE #define ABORT_ON_ASSERT_FAILURE 1 #endif /* ABORT_ON_ASSERT_FAILURE */ #ifndef PROCEED_ON_ERROR #define PROCEED_ON_ERROR 0 #endif /* PROCEED_ON_ERROR */ #ifndef INSECURE #define INSECURE 0 #endif /* INSECURE */ #ifndef MALLOC_INSPECT_ALL #define MALLOC_INSPECT_ALL 0 #endif /* MALLOC_INSPECT_ALL */ #ifndef HAVE_MMAP #define HAVE_MMAP 1 #endif /* HAVE_MMAP */ #ifndef MMAP_CLEARS #define MMAP_CLEARS 1 #endif /* MMAP_CLEARS */ #ifndef HAVE_MREMAP #ifdef linux #define HAVE_MREMAP 1 #define _GNU_SOURCE /* Turns on mremap() definition */ #else /* linux */ #define HAVE_MREMAP 0 #endif /* linux */ #endif /* HAVE_MREMAP */ #ifndef MALLOC_FAILURE_ACTION #define MALLOC_FAILURE_ACTION errno = ENOMEM; #endif /* MALLOC_FAILURE_ACTION */ #ifndef HAVE_MORECORE #if ONLY_MSPACES #define HAVE_MORECORE 0 #else /* ONLY_MSPACES */ #define HAVE_MORECORE 1 #endif /* ONLY_MSPACES */ #endif /* HAVE_MORECORE */ #if !HAVE_MORECORE #define MORECORE_CONTIGUOUS 0 #else /* !HAVE_MORECORE */ #define MORECORE_DEFAULT sbrk #ifndef MORECORE_CONTIGUOUS #define MORECORE_CONTIGUOUS 1 #endif /* MORECORE_CONTIGUOUS */ #endif /* HAVE_MORECORE */ #ifndef DEFAULT_GRANULARITY #if (MORECORE_CONTIGUOUS || defined(WIN32)) #define DEFAULT_GRANULARITY (0) /* 0 means to compute in init_mparams */ #else /* MORECORE_CONTIGUOUS */ #define DEFAULT_GRANULARITY ((size_t)64U * (size_t)1024U) #endif /* MORECORE_CONTIGUOUS */ #endif /* DEFAULT_GRANULARITY */ #ifndef DEFAULT_TRIM_THRESHOLD #ifndef MORECORE_CANNOT_TRIM #define DEFAULT_TRIM_THRESHOLD ((size_t)2U * (size_t)1024U * (size_t)1024U) #else /* MORECORE_CANNOT_TRIM */ #define DEFAULT_TRIM_THRESHOLD MAX_SIZE_T #endif /* MORECORE_CANNOT_TRIM */ #endif /* DEFAULT_TRIM_THRESHOLD */ #ifndef DEFAULT_MMAP_THRESHOLD #if HAVE_MMAP #define DEFAULT_MMAP_THRESHOLD ((size_t)256U * (size_t)1024U) #else /* HAVE_MMAP */ #define DEFAULT_MMAP_THRESHOLD MAX_SIZE_T #endif /* HAVE_MMAP */ #endif /* DEFAULT_MMAP_THRESHOLD */ #ifndef MAX_RELEASE_CHECK_RATE #if HAVE_MMAP #define MAX_RELEASE_CHECK_RATE 4095 #else #define MAX_RELEASE_CHECK_RATE MAX_SIZE_T #endif /* HAVE_MMAP */ #endif /* MAX_RELEASE_CHECK_RATE */ #ifndef USE_BUILTIN_FFS #define USE_BUILTIN_FFS 0 #endif /* USE_BUILTIN_FFS */ #ifndef USE_DEV_RANDOM #define USE_DEV_RANDOM 0 #endif /* USE_DEV_RANDOM */ #ifndef NO_MALLINFO #define NO_MALLINFO 0 #endif /* NO_MALLINFO */ #ifndef MALLINFO_FIELD_TYPE #define MALLINFO_FIELD_TYPE size_t #endif /* MALLINFO_FIELD_TYPE */ #ifndef NO_MALLOC_STATS #define NO_MALLOC_STATS 0 #endif /* NO_MALLOC_STATS */ #ifndef NO_SEGMENT_TRAVERSAL #define NO_SEGMENT_TRAVERSAL 0 #endif /* NO_SEGMENT_TRAVERSAL */ /* mallopt tuning options. SVID/XPG defines four standard parameter numbers for mallopt, normally defined in malloc.h. None of these are used in this malloc, so setting them has no effect. But this malloc does support the following options. */ #define M_TRIM_THRESHOLD (-1) #define M_GRANULARITY (-2) #define M_MMAP_THRESHOLD (-3) /* ------------------------ Mallinfo declarations ------------------------ */ #if !NO_MALLINFO /* This version of malloc supports the standard SVID/XPG mallinfo routine that returns a struct containing usage properties and statistics. It should work on any system that has a /usr/include/malloc.h defining struct mallinfo. The main declaration needed is the mallinfo struct that is returned (by-copy) by mallinfo(). The malloinfo struct contains a bunch of fields that are not even meaningful in this version of malloc. These fields are are instead filled by mallinfo() with other numbers that might be of interest. HAVE_USR_INCLUDE_MALLOC_H should be set if you have a /usr/include/malloc.h file that includes a declaration of struct mallinfo. If so, it is included; else a compliant version is declared below. These must be precisely the same for mallinfo() to work. The original SVID version of this struct, defined on most systems with mallinfo, declares all fields as ints. But some others define as unsigned long. If your system defines the fields using a type of different width than listed here, you MUST #include your system version and #define HAVE_USR_INCLUDE_MALLOC_H. */ /* #define HAVE_USR_INCLUDE_MALLOC_H */ #ifdef HAVE_USR_INCLUDE_MALLOC_H #include "/usr/include/malloc.h" #else /* HAVE_USR_INCLUDE_MALLOC_H */ #ifndef STRUCT_MALLINFO_DECLARED /* HP-UX (and others?) redefines mallinfo unless _STRUCT_MALLINFO is defined */ #define _STRUCT_MALLINFO #define STRUCT_MALLINFO_DECLARED 1 struct mallinfo { MALLINFO_FIELD_TYPE arena; /* non-mmapped space allocated from system */ MALLINFO_FIELD_TYPE ordblks; /* number of free chunks */ MALLINFO_FIELD_TYPE smblks; /* always 0 */ MALLINFO_FIELD_TYPE hblks; /* always 0 */ MALLINFO_FIELD_TYPE hblkhd; /* space in mmapped regions */ MALLINFO_FIELD_TYPE usmblks; /* maximum total allocated space */ MALLINFO_FIELD_TYPE fsmblks; /* always 0 */ MALLINFO_FIELD_TYPE uordblks; /* total allocated space */ MALLINFO_FIELD_TYPE fordblks; /* total free space */ MALLINFO_FIELD_TYPE keepcost; /* releasable (via malloc_trim) space */ }; #endif /* STRUCT_MALLINFO_DECLARED */ #endif /* HAVE_USR_INCLUDE_MALLOC_H */ #endif /* NO_MALLINFO */ /* Try to persuade compilers to inline. The most critical functions for inlining are defined as macros, so these aren't used for them. */ #ifndef FORCEINLINE #if defined(__GNUC__) #define FORCEINLINE __inline __attribute__ ((always_inline)) #elif defined(_MSC_VER) #define FORCEINLINE __forceinline #endif #endif #ifndef NOINLINE #if defined(__GNUC__) #define NOINLINE __attribute__ ((noinline)) #elif defined(_MSC_VER) #define NOINLINE __declspec(noinline) #else #define NOINLINE #endif #endif #ifdef __cplusplus extern "C" { #ifndef FORCEINLINE #define FORCEINLINE inline #endif #endif /* __cplusplus */ #ifndef FORCEINLINE #define FORCEINLINE #endif #if !ONLY_MSPACES /* ------------------- Declarations of public routines ------------------- */ #ifndef USE_DL_PREFIX #define dlcalloc calloc #define dlfree free #define dlmalloc malloc #define dlmemalign memalign #define dlposix_memalign posix_memalign #define dlrealloc realloc #define dlrealloc_in_place realloc_in_place #define dlvalloc valloc #define dlpvalloc pvalloc #define dlmallinfo mallinfo #define dlmallopt mallopt #define dlmalloc_trim malloc_trim #define dlmalloc_stats malloc_stats #define dlmalloc_usable_size malloc_usable_size #define dlmalloc_footprint malloc_footprint #define dlmalloc_max_footprint malloc_max_footprint #define dlmalloc_footprint_limit malloc_footprint_limit #define dlmalloc_set_footprint_limit malloc_set_footprint_limit #define dlmalloc_inspect_all malloc_inspect_all #define dlindependent_calloc independent_calloc #define dlindependent_comalloc independent_comalloc #define dlbulk_free bulk_free #endif /* USE_DL_PREFIX */ /* malloc(size_t n) Returns a pointer to a newly allocated chunk of at least n bytes, or null if no space is available, in which case errno is set to ENOMEM on ANSI C systems. If n is zero, malloc returns a minimum-sized chunk. (The minimum size is 16 bytes on most 32bit systems, and 32 bytes on 64bit systems.) Note that size_t is an unsigned type, so calls with arguments that would be negative if signed are interpreted as requests for huge amounts of space, which will often fail. The maximum supported value of n differs across systems, but is in all cases less than the maximum representable value of a size_t. */ DLMALLOC_EXPORT void* dlmalloc(size_t); /* free(void* p) Releases the chunk of memory pointed to by p, that had been previously allocated using malloc or a related routine such as realloc. It has no effect if p is null. If p was not malloced or already freed, free(p) will by default cause the current program to abort. */ DLMALLOC_EXPORT void dlfree(void*); /* calloc(size_t n_elements, size_t element_size); Returns a pointer to n_elements * element_size bytes, with all locations set to zero. */ DLMALLOC_EXPORT void* dlcalloc(size_t, size_t); /* realloc(void* p, size_t n) Returns a pointer to a chunk of size n that contains the same data as does chunk p up to the minimum of (n, p's size) bytes, or null if no space is available. The returned pointer may or may not be the same as p. The algorithm prefers extending p in most cases when possible, otherwise it employs the equivalent of a malloc-copy-free sequence. If p is null, realloc is equivalent to malloc. If space is not available, realloc returns null, errno is set (if on ANSI) and p is NOT freed. if n is for fewer bytes than already held by p, the newly unused space is lopped off and freed if possible. realloc with a size argument of zero (re)allocates a minimum-sized chunk. The old unix realloc convention of allowing the last-free'd chunk to be used as an argument to realloc is not supported. */ DLMALLOC_EXPORT void* dlrealloc(void*, size_t); /* realloc_in_place(void* p, size_t n) Resizes the space allocated for p to size n, only if this can be done without moving p (i.e., only if there is adjacent space available if n is greater than p's current allocated size, or n is less than or equal to p's size). This may be used instead of plain realloc if an alternative allocation strategy is needed upon failure to expand space; for example, reallocation of a buffer that must be memory-aligned or cleared. You can use realloc_in_place to trigger these alternatives only when needed. Returns p if successful; otherwise null. */ DLMALLOC_EXPORT void* dlrealloc_in_place(void*, size_t); /* memalign(size_t alignment, size_t n); Returns a pointer to a newly allocated chunk of n bytes, aligned in accord with the alignment argument. The alignment argument should be a power of two. If the argument is not a power of two, the nearest greater power is used. 8-byte alignment is guaranteed by normal malloc calls, so don't bother calling memalign with an argument of 8 or less. Overreliance on memalign is a sure way to fragment space. */ DLMALLOC_EXPORT void* dlmemalign(size_t, size_t); /* int posix_memalign(void** pp, size_t alignment, size_t n); Allocates a chunk of n bytes, aligned in accord with the alignment argument. Differs from memalign only in that it (1) assigns the allocated memory to *pp rather than returning it, (2) fails and returns EINVAL if the alignment is not a power of two (3) fails and returns ENOMEM if memory cannot be allocated. */ DLMALLOC_EXPORT int dlposix_memalign(void**, size_t, size_t); /* valloc(size_t n); Equivalent to memalign(pagesize, n), where pagesize is the page size of the system. If the pagesize is unknown, 4096 is used. */ DLMALLOC_EXPORT void* dlvalloc(size_t); /* mallopt(int parameter_number, int parameter_value) Sets tunable parameters The format is to provide a (parameter-number, parameter-value) pair. mallopt then sets the corresponding parameter to the argument value if it can (i.e., so long as the value is meaningful), and returns 1 if successful else 0. To workaround the fact that mallopt is specified to use int, not size_t parameters, the value -1 is specially treated as the maximum unsigned size_t value. SVID/XPG/ANSI defines four standard param numbers for mallopt, normally defined in malloc.h. None of these are use in this malloc, so setting them has no effect. But this malloc also supports other options in mallopt. See below for details. Briefly, supported parameters are as follows (listed defaults are for "typical" configurations). Symbol param # default allowed param values M_TRIM_THRESHOLD -1 2*1024*1024 any (-1 disables) M_GRANULARITY -2 page size any power of 2 >= page size M_MMAP_THRESHOLD -3 256*1024 any (or 0 if no MMAP support) */ DLMALLOC_EXPORT int dlmallopt(int, int); /* malloc_footprint(); Returns the number of bytes obtained from the system. The total number of bytes allocated by malloc, realloc etc., is less than this value. Unlike mallinfo, this function returns only a precomputed result, so can be called frequently to monitor memory consumption. Even if locks are otherwise defined, this function does not use them, so results might not be up to date. */ DLMALLOC_EXPORT size_t dlmalloc_footprint(void); /* malloc_max_footprint(); Returns the maximum number of bytes obtained from the system. This value will be greater than current footprint if deallocated space has been reclaimed by the system. The peak number of bytes allocated by malloc, realloc etc., is less than this value. Unlike mallinfo, this function returns only a precomputed result, so can be called frequently to monitor memory consumption. Even if locks are otherwise defined, this function does not use them, so results might not be up to date. */ DLMALLOC_EXPORT size_t dlmalloc_max_footprint(void); /* malloc_footprint_limit(); Returns the number of bytes that the heap is allowed to obtain from the system, returning the last value returned by malloc_set_footprint_limit, or the maximum size_t value if never set. The returned value reflects a permission. There is no guarantee that this number of bytes can actually be obtained from the system. */ DLMALLOC_EXPORT size_t dlmalloc_footprint_limit(); /* malloc_set_footprint_limit(); Sets the maximum number of bytes to obtain from the system, causing failure returns from malloc and related functions upon attempts to exceed this value. The argument value may be subject to page rounding to an enforceable limit; this actual value is returned. Using an argument of the maximum possible size_t effectively disables checks. If the argument is less than or equal to the current malloc_footprint, then all future allocations that require additional system memory will fail. However, invocation cannot retroactively deallocate existing used memory. */ DLMALLOC_EXPORT size_t dlmalloc_set_footprint_limit(size_t bytes); #if MALLOC_INSPECT_ALL /* malloc_inspect_all(void(*handler)(void *start, void *end, size_t used_bytes, void* callback_arg), void* arg); Traverses the heap and calls the given handler for each managed region, skipping all bytes that are (or may be) used for bookkeeping purposes. Traversal does not include include chunks that have been directly memory mapped. Each reported region begins at the start address, and continues up to but not including the end address. The first used_bytes of the region contain allocated data. If used_bytes is zero, the region is unallocated. The handler is invoked with the given callback argument. If locks are defined, they are held during the entire traversal. It is a bad idea to invoke other malloc functions from within the handler. For example, to count the number of in-use chunks with size greater than 1000, you could write: static int count = 0; void count_chunks(void* start, void* end, size_t used, void* arg) { if (used >= 1000) ++count; } then: malloc_inspect_all(count_chunks, NULL); malloc_inspect_all is compiled only if MALLOC_INSPECT_ALL is defined. */ DLMALLOC_EXPORT void dlmalloc_inspect_all(void(*handler)(void*, void *, size_t, void*), void* arg); #endif /* MALLOC_INSPECT_ALL */ #if !NO_MALLINFO /* mallinfo() Returns (by copy) a struct containing various summary statistics: arena: current total non-mmapped bytes allocated from system ordblks: the number of free chunks smblks: always zero. hblks: current number of mmapped regions hblkhd: total bytes held in mmapped regions usmblks: the maximum total allocated space. This will be greater than current total if trimming has occurred. fsmblks: always zero uordblks: current total allocated space (normal or mmapped) fordblks: total free space keepcost: the maximum number of bytes that could ideally be released back to system via malloc_trim. ("ideally" means that it ignores page restrictions etc.) Because these fields are ints, but internal bookkeeping may be kept as longs, the reported values may wrap around zero and thus be inaccurate. */ DLMALLOC_EXPORT struct mallinfo dlmallinfo(void); #endif /* NO_MALLINFO */ /* independent_calloc(size_t n_elements, size_t element_size, void* chunks[]); independent_calloc is similar to calloc, but instead of returning a single cleared space, it returns an array of pointers to n_elements independent elements that can hold contents of size elem_size, each of which starts out cleared, and can be independently freed, realloc'ed etc. The elements are guaranteed to be adjacently allocated (this is not guaranteed to occur with multiple callocs or mallocs), which may also improve cache locality in some applications. The "chunks" argument is optional (i.e., may be null, which is probably the most typical usage). If it is null, the returned array is itself dynamically allocated and should also be freed when it is no longer needed. Otherwise, the chunks array must be of at least n_elements in length. It is filled in with the pointers to the chunks. In either case, independent_calloc returns this pointer array, or null if the allocation failed. If n_elements is zero and "chunks" is null, it returns a chunk representing an array with zero elements (which should be freed if not wanted). Each element must be freed when it is no longer needed. This can be done all at once using bulk_free. independent_calloc simplifies and speeds up implementations of many kinds of pools. It may also be useful when constructing large data structures that initially have a fixed number of fixed-sized nodes, but the number is not known at compile time, and some of the nodes may later need to be freed. For example: struct Node { int item; struct Node* next; }; struct Node* build_list() { struct Node** pool; int n = read_number_of_nodes_needed(); if (n <= 0) return 0; pool = (struct Node**)(independent_calloc(n, sizeof(struct Node), 0); if (pool == 0) die(); // organize into a linked list... struct Node* first = pool[0]; for (i = 0; i < n-1; ++i) pool[i]->next = pool[i+1]; free(pool); // Can now free the array (or not, if it is needed later) return first; } */ DLMALLOC_EXPORT void** dlindependent_calloc(size_t, size_t, void**); /* independent_comalloc(size_t n_elements, size_t sizes[], void* chunks[]); independent_comalloc allocates, all at once, a set of n_elements chunks with sizes indicated in the "sizes" array. It returns an array of pointers to these elements, each of which can be independently freed, realloc'ed etc. The elements are guaranteed to be adjacently allocated (this is not guaranteed to occur with multiple callocs or mallocs), which may also improve cache locality in some applications. The "chunks" argument is optional (i.e., may be null). If it is null the returned array is itself dynamically allocated and should also be freed when it is no longer needed. Otherwise, the chunks array must be of at least n_elements in length. It is filled in with the pointers to the chunks. In either case, independent_comalloc returns this pointer array, or null if the allocation failed. If n_elements is zero and chunks is null, it returns a chunk representing an array with zero elements (which should be freed if not wanted). Each element must be freed when it is no longer needed. This can be done all at once using bulk_free. independent_comallac differs from independent_calloc in that each element may have a different size, and also that it does not automatically clear elements. independent_comalloc can be used to speed up allocation in cases where several structs or objects must always be allocated at the same time. For example: struct Head { ... } struct Foot { ... } void send_message(char* msg) { int msglen = strlen(msg); size_t sizes[3] = { sizeof(struct Head), msglen, sizeof(struct Foot) }; void* chunks[3]; if (independent_comalloc(3, sizes, chunks) == 0) die(); struct Head* head = (struct Head*)(chunks[0]); char* body = (char*)(chunks[1]); struct Foot* foot = (struct Foot*)(chunks[2]); // ... } In general though, independent_comalloc is worth using only for larger values of n_elements. For small values, you probably won't detect enough difference from series of malloc calls to bother. Overuse of independent_comalloc can increase overall memory usage, since it cannot reuse existing noncontiguous small chunks that might be available for some of the elements. */ DLMALLOC_EXPORT void** dlindependent_comalloc(size_t, size_t*, void**); /* bulk_free(void* array[], size_t n_elements) Frees and clears (sets to null) each non-null pointer in the given array. This is likely to be faster than freeing them one-by-one. If footers are used, pointers that have been allocated in different mspaces are not freed or cleared, and the count of all such pointers is returned. For large arrays of pointers with poor locality, it may be worthwhile to sort this array before calling bulk_free. */ DLMALLOC_EXPORT size_t dlbulk_free(void**, size_t n_elements); /* pvalloc(size_t n); Equivalent to valloc(minimum-page-that-holds(n)), that is, round up n to nearest pagesize. */ DLMALLOC_EXPORT void* dlpvalloc(size_t); /* malloc_trim(size_t pad); If possible, gives memory back to the system (via negative arguments to sbrk) if there is unused memory at the `high' end of the malloc pool or in unused MMAP segments. You can call this after freeing large blocks of memory to potentially reduce the system-level memory requirements of a program. However, it cannot guarantee to reduce memory. Under some allocation patterns, some large free blocks of memory will be locked between two used chunks, so they cannot be given back to the system. The `pad' argument to malloc_trim represents the amount of free trailing space to leave untrimmed. If this argument is zero, only the minimum amount of memory to maintain internal data structures will be left. Non-zero arguments can be supplied to maintain enough trailing space to service future expected allocations without having to re-obtain memory from the system. Malloc_trim returns 1 if it actually released any memory, else 0. */ DLMALLOC_EXPORT int dlmalloc_trim(size_t); /* malloc_stats(); Prints on stderr the amount of space obtained from the system (both via sbrk and mmap), the maximum amount (which may be more than current if malloc_trim and/or munmap got called), and the current number of bytes allocated via malloc (or realloc, etc) but not yet freed. Note that this is the number of bytes allocated, not the number requested. It will be larger than the number requested because of alignment and bookkeeping overhead. Because it includes alignment wastage as being in use, this figure may be greater than zero even when no user-level chunks are allocated. The reported current and maximum system memory can be inaccurate if a program makes other calls to system memory allocation functions (normally sbrk) outside of malloc. malloc_stats prints only the most commonly interesting statistics. More information can be obtained by calling mallinfo. */ DLMALLOC_EXPORT void dlmalloc_stats(void); #endif /* ONLY_MSPACES */ /* malloc_usable_size(void* p); Returns the number of bytes you can actually use in an allocated chunk, which may be more than you requested (although often not) due to alignment and minimum size constraints. You can use this many bytes without worrying about overwriting other allocated objects. This is not a particularly great programming practice. malloc_usable_size can be more useful in debugging and assertions, for example: p = malloc(n); assert(malloc_usable_size(p) >= 256); */ size_t dlmalloc_usable_size(void*); #if MSPACES /* mspace is an opaque type representing an independent region of space that supports mspace_malloc, etc. */ typedef void* mspace; /* create_mspace creates and returns a new independent space with the given initial capacity, or, if 0, the default granularity size. It returns null if there is no system memory available to create the space. If argument locked is non-zero, the space uses a separate lock to control access. The capacity of the space will grow dynamically as needed to service mspace_malloc requests. You can control the sizes of incremental increases of this space by compiling with a different DEFAULT_GRANULARITY or dynamically setting with mallopt(M_GRANULARITY, value). */ DLMALLOC_EXPORT mspace create_mspace(size_t capacity, int locked); /* destroy_mspace destroys the given space, and attempts to return all of its memory back to the system, returning the total number of bytes freed. After destruction, the results of access to all memory used by the space become undefined. */ DLMALLOC_EXPORT size_t destroy_mspace(mspace msp); /* create_mspace_with_base uses the memory supplied as the initial base of a new mspace. Part (less than 128*sizeof(size_t) bytes) of this space is used for bookkeeping, so the capacity must be at least this large. (Otherwise 0 is returned.) When this initial space is exhausted, additional memory will be obtained from the system. Destroying this space will deallocate all additionally allocated space (if possible) but not the initial base. */ DLMALLOC_EXPORT mspace create_mspace_with_base(void* base, size_t capacity, int locked); /* mspace_track_large_chunks controls whether requests for large chunks are allocated in their own untracked mmapped regions, separate from others in this mspace. By default large chunks are not tracked, which reduces fragmentation. However, such chunks are not necessarily released to the system upon destroy_mspace. Enabling tracking by setting to true may increase fragmentation, but avoids leakage when relying on destroy_mspace to release all memory allocated using this space. The function returns the previous setting. */ DLMALLOC_EXPORT int mspace_track_large_chunks(mspace msp, int enable); /* mspace_malloc behaves as malloc, but operates within the given space. */ DLMALLOC_EXPORT void* mspace_malloc(mspace msp, size_t bytes); /* mspace_free behaves as free, but operates within the given space. If compiled with FOOTERS==1, mspace_free is not actually needed. free may be called instead of mspace_free because freed chunks from any space are handled by their originating spaces. */ DLMALLOC_EXPORT void mspace_free(mspace msp, void* mem); /* mspace_realloc behaves as realloc, but operates within the given space. If compiled with FOOTERS==1, mspace_realloc is not actually needed. realloc may be called instead of mspace_realloc because realloced chunks from any space are handled by their originating spaces. */ DLMALLOC_EXPORT void* mspace_realloc(mspace msp, void* mem, size_t newsize); /* mspace_calloc behaves as calloc, but operates within the given space. */ DLMALLOC_EXPORT void* mspace_calloc(mspace msp, size_t n_elements, size_t elem_size); /* mspace_memalign behaves as memalign, but operates within the given space. */ DLMALLOC_EXPORT void* mspace_memalign(mspace msp, size_t alignment, size_t bytes); /* mspace_independent_calloc behaves as independent_calloc, but operates within the given space. */ DLMALLOC_EXPORT void** mspace_independent_calloc(mspace msp, size_t n_elements, size_t elem_size, void* chunks[]); /* mspace_independent_comalloc behaves as independent_comalloc, but operates within the given space. */ DLMALLOC_EXPORT void** mspace_independent_comalloc(mspace msp, size_t n_elements, size_t sizes[], void* chunks[]); /* mspace_footprint() returns the number of bytes obtained from the system for this space. */ DLMALLOC_EXPORT size_t mspace_footprint(mspace msp); /* mspace_max_footprint() returns the peak number of bytes obtained from the system for this space. */ DLMALLOC_EXPORT size_t mspace_max_footprint(mspace msp); #if !NO_MALLINFO /* mspace_mallinfo behaves as mallinfo, but reports properties of the given space. */ DLMALLOC_EXPORT struct mallinfo mspace_mallinfo(mspace msp); #endif /* NO_MALLINFO */ /* malloc_usable_size(void* p) behaves the same as malloc_usable_size; */ DLMALLOC_EXPORT size_t mspace_usable_size(void* mem); /* mspace_malloc_stats behaves as malloc_stats, but reports properties of the given space. */ DLMALLOC_EXPORT void mspace_malloc_stats(mspace msp); /* mspace_trim behaves as malloc_trim, but operates within the given space. */ DLMALLOC_EXPORT int mspace_trim(mspace msp, size_t pad); /* An alias for mallopt. */ DLMALLOC_EXPORT int mspace_mallopt(int, int); #endif /* MSPACES */ #ifdef __cplusplus } /* end of extern "C" */ #endif /* __cplusplus */ /* ======================================================================== To make a fully customizable malloc.h header file, cut everything above this line, put into file malloc.h, edit to suit, and #include it on the next line, as well as in programs that use this malloc. ======================================================================== */ /* #include "malloc.h" */ /*------------------------------ internal #includes ---------------------- */ #ifdef _MSC_VER #pragma warning( disable : 4146 ) /* no "unsigned" warnings */ #endif /* _MSC_VER */ #if !NO_MALLOC_STATS #include <stdio.h> /* for printing in malloc_stats */ #endif /* NO_MALLOC_STATS */ #ifndef LACKS_ERRNO_H #include <errno.h> /* for MALLOC_FAILURE_ACTION */ #endif /* LACKS_ERRNO_H */ #ifdef DEBUG #if ABORT_ON_ASSERT_FAILURE #undef assert #define assert(x) if(!(x)) ABORT #else /* ABORT_ON_ASSERT_FAILURE */ #include <assert.h> #endif /* ABORT_ON_ASSERT_FAILURE */ #else /* DEBUG */ #ifndef assert #define assert(x) #endif #define DEBUG 0 #endif /* DEBUG */ #if !defined(WIN32) && !defined(LACKS_TIME_H) #include <time.h> /* for magic initialization */ #endif /* WIN32 */ #ifndef LACKS_STDLIB_H #include <stdlib.h> /* for abort() */ #endif /* LACKS_STDLIB_H */ #ifndef LACKS_STRING_H #include <string.h> /* for memset etc */ #endif /* LACKS_STRING_H */ #if USE_BUILTIN_FFS #ifndef LACKS_STRINGS_H #include <strings.h> /* for ffs */ #endif /* LACKS_STRINGS_H */ #endif /* USE_BUILTIN_FFS */ #if HAVE_MMAP #ifndef LACKS_SYS_MMAN_H /* On some versions of linux, mremap decl in mman.h needs __USE_GNU set */ #if (defined(linux) && !defined(__USE_GNU)) #define __USE_GNU 1 #include <sys/mman.h> /* for mmap */ #undef __USE_GNU #else #include <sys/mman.h> /* for mmap */ #endif /* linux */ #endif /* LACKS_SYS_MMAN_H */ #ifndef LACKS_FCNTL_H #include <fcntl.h> #endif /* LACKS_FCNTL_H */ #endif /* HAVE_MMAP */ #ifndef LACKS_UNISTD_H #include <unistd.h> /* for sbrk, sysconf */ #else /* LACKS_UNISTD_H */ #if !defined(__FreeBSD__) && !defined(__OpenBSD__) && !defined(__NetBSD__) extern void* sbrk(ptrdiff_t); #endif /* FreeBSD etc */ #endif /* LACKS_UNISTD_H */ /* Declarations for locking */ #if USE_LOCKS #ifndef WIN32 #if defined (__SVR4) && defined (__sun) /* solaris */ #include <thread.h> #elif !defined(LACKS_SCHED_H) #include <sched.h> #endif /* solaris or LACKS_SCHED_H */ #if (defined(USE_RECURSIVE_LOCKS) && USE_RECURSIVE_LOCKS != 0) || !USE_SPIN_LOCKS #include <pthread.h> #endif /* USE_RECURSIVE_LOCKS ... */ #elif defined(_MSC_VER) #ifndef _M_AMD64 /* These are already defined on AMD64 builds */ #ifdef __cplusplus extern "C" { #endif /* __cplusplus */ LONG __cdecl _InterlockedCompareExchange(LONG volatile *Dest, LONG Exchange, LONG Comp); LONG __cdecl _InterlockedExchange(LONG volatile *Target, LONG Value); #ifdef __cplusplus } #endif /* __cplusplus */ #endif /* _M_AMD64 */ #pragma intrinsic (_InterlockedCompareExchange) #pragma intrinsic (_InterlockedExchange) #define interlockedcompareexchange _InterlockedCompareExchange #define interlockedexchange _InterlockedExchange #elif defined(WIN32) && defined(__GNUC__) #define interlockedcompareexchange(a, b, c) __sync_val_compare_and_swap(a, c, b) #define interlockedexchange __sync_lock_test_and_set #endif /* Win32 */ #endif /* USE_LOCKS */ /* Declarations for bit scanning on win32 */ #if defined(_MSC_VER) && _MSC_VER>=1300 #ifndef BitScanForward /* Try to avoid pulling in WinNT.h */ #ifdef __cplusplus extern "C" { #endif /* __cplusplus */ unsigned char _BitScanForward(unsigned long *index, unsigned long mask); unsigned char _BitScanReverse(unsigned long *index, unsigned long mask); #ifdef __cplusplus } #endif /* __cplusplus */ #define BitScanForward _BitScanForward #define BitScanReverse _BitScanReverse #pragma intrinsic(_BitScanForward) #pragma intrinsic(_BitScanReverse) #endif /* BitScanForward */ #endif /* defined(_MSC_VER) && _MSC_VER>=1300 */ #ifndef WIN32 #ifndef malloc_getpagesize # ifdef _SC_PAGESIZE /* some SVR4 systems omit an underscore */ # ifndef _SC_PAGE_SIZE # define _SC_PAGE_SIZE _SC_PAGESIZE # endif # endif # ifdef _SC_PAGE_SIZE # define malloc_getpagesize sysconf(_SC_PAGE_SIZE) # else # if defined(BSD) || defined(DGUX) || defined(HAVE_GETPAGESIZE) extern size_t getpagesize(); # define malloc_getpagesize getpagesize() # else # ifdef WIN32 /* use supplied emulation of getpagesize */ # define malloc_getpagesize getpagesize() # else # ifndef LACKS_SYS_PARAM_H # include <sys/param.h> # endif # ifdef EXEC_PAGESIZE # define malloc_getpagesize EXEC_PAGESIZE # else # ifdef NBPG # ifndef CLSIZE # define malloc_getpagesize NBPG # else # define malloc_getpagesize (NBPG * CLSIZE) # endif # else # ifdef NBPC # define malloc_getpagesize NBPC # else # ifdef PAGESIZE # define malloc_getpagesize PAGESIZE # else /* just guess */ # define malloc_getpagesize ((size_t)4096U) # endif # endif # endif # endif # endif # endif # endif #endif #endif /* ------------------- size_t and alignment properties -------------------- */ /* The byte and bit size of a size_t */ #define SIZE_T_SIZE (sizeof(size_t)) #define SIZE_T_BITSIZE (sizeof(size_t) << 3) /* Some constants coerced to size_t */ /* Annoying but necessary to avoid errors on some platforms */ #define SIZE_T_ZERO ((size_t)0) #define SIZE_T_ONE ((size_t)1) #define SIZE_T_TWO ((size_t)2) #define SIZE_T_FOUR ((size_t)4) #define TWO_SIZE_T_SIZES (SIZE_T_SIZE<<1) #define FOUR_SIZE_T_SIZES (SIZE_T_SIZE<<2) #define SIX_SIZE_T_SIZES (FOUR_SIZE_T_SIZES+TWO_SIZE_T_SIZES) #define HALF_MAX_SIZE_T (MAX_SIZE_T / 2U) /* The bit mask value corresponding to MALLOC_ALIGNMENT */ #define CHUNK_ALIGN_MASK (MALLOC_ALIGNMENT - SIZE_T_ONE) /* True if address a has acceptable alignment */ #define is_aligned(A) (((size_t)((A)) & (CHUNK_ALIGN_MASK)) == 0) /* the number of bytes to offset an address to align it */ #define align_offset(A)\ ((((size_t)(A) & CHUNK_ALIGN_MASK) == 0)? 0 :\ ((MALLOC_ALIGNMENT - ((size_t)(A) & CHUNK_ALIGN_MASK)) & CHUNK_ALIGN_MASK)) /* -------------------------- MMAP preliminaries ------------------------- */ /* If HAVE_MORECORE or HAVE_MMAP are false, we just define calls and checks to fail so compiler optimizer can delete code rather than using so many "#if"s. */ /* MORECORE and MMAP must return MFAIL on failure */ #define MFAIL ((void*)(MAX_SIZE_T)) #define CMFAIL ((char*)(MFAIL)) /* defined for convenience */ #if HAVE_MMAP #ifndef WIN32 #define MUNMAP_DEFAULT(a, s) munmap((a), (s)) #define MMAP_PROT (PROT_READ|PROT_WRITE) #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) #define MAP_ANONYMOUS MAP_ANON #endif /* MAP_ANON */ #ifdef MAP_ANONYMOUS #define MMAP_FLAGS (MAP_PRIVATE|MAP_ANONYMOUS) #define MMAP_DEFAULT(s) mmap(0, (s), MMAP_PROT, MMAP_FLAGS, -1, 0) #else /* MAP_ANONYMOUS */ /* Nearly all versions of mmap support MAP_ANONYMOUS, so the following is unlikely to be needed, but is supplied just in case. */ #define MMAP_FLAGS (MAP_PRIVATE) static int dev_zero_fd = -1; /* Cached file descriptor for /dev/zero. */ #define MMAP_DEFAULT(s) ((dev_zero_fd < 0) ? \ (dev_zero_fd = open("/dev/zero", O_RDWR), \ mmap(0, (s), MMAP_PROT, MMAP_FLAGS, dev_zero_fd, 0)) : \ mmap(0, (s), MMAP_PROT, MMAP_FLAGS, dev_zero_fd, 0)) #endif /* MAP_ANONYMOUS */ #define DIRECT_MMAP_DEFAULT(s) MMAP_DEFAULT(s) #else /* WIN32 */ /* Win32 MMAP via VirtualAlloc */ static FORCEINLINE void* win32mmap(size_t size) { void* ptr = VirtualAlloc(0, size, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE); return (ptr != 0)? ptr: MFAIL; } /* For direct MMAP, use MEM_TOP_DOWN to minimize interference */ static FORCEINLINE void* win32direct_mmap(size_t size) { void* ptr = VirtualAlloc(0, size, MEM_RESERVE|MEM_COMMIT|MEM_TOP_DOWN, PAGE_READWRITE); return (ptr != 0)? ptr: MFAIL; } /* This function supports releasing coalesed segments */ static FORCEINLINE int win32munmap(void* ptr, size_t size) { MEMORY_BASIC_INFORMATION minfo; char* cptr = (char*)ptr; while (size) { if (VirtualQuery(cptr, &minfo, sizeof(minfo)) == 0) return -1; if (minfo.BaseAddress != cptr || minfo.AllocationBase != cptr || minfo.State != MEM_COMMIT || minfo.RegionSize > size) return -1; if (VirtualFree(cptr, 0, MEM_RELEASE) == 0) return -1; cptr += minfo.RegionSize; size -= minfo.RegionSize; } return 0; } #define MMAP_DEFAULT(s) win32mmap(s) #define MUNMAP_DEFAULT(a, s) win32munmap((a), (s)) #define DIRECT_MMAP_DEFAULT(s) win32direct_mmap(s) #endif /* WIN32 */ #endif /* HAVE_MMAP */ #if HAVE_MREMAP #ifndef WIN32 #define MREMAP_DEFAULT(addr, osz, nsz, mv) mremap((addr), (osz), (nsz), (mv)) #endif /* WIN32 */ #endif /* HAVE_MREMAP */ /** * Define CALL_MORECORE */ #if HAVE_MORECORE #ifdef MORECORE #define CALL_MORECORE(S) MORECORE(S) #else /* MORECORE */ #define CALL_MORECORE(S) MORECORE_DEFAULT(S) #endif /* MORECORE */ #else /* HAVE_MORECORE */ #define CALL_MORECORE(S) MFAIL #endif /* HAVE_MORECORE */ /** * Define CALL_MMAP/CALL_MUNMAP/CALL_DIRECT_MMAP */ #if HAVE_MMAP #define USE_MMAP_BIT (SIZE_T_ONE) #ifdef MMAP #define CALL_MMAP(s) MMAP(s) #else /* MMAP */ #define CALL_MMAP(s) MMAP_DEFAULT(s) #endif /* MMAP */ #ifdef MUNMAP #define CALL_MUNMAP(a, s) MUNMAP((a), (s)) #else /* MUNMAP */ #define CALL_MUNMAP(a, s) MUNMAP_DEFAULT((a), (s)) #endif /* MUNMAP */ #ifdef DIRECT_MMAP #define CALL_DIRECT_MMAP(s) DIRECT_MMAP(s) #else /* DIRECT_MMAP */ #define CALL_DIRECT_MMAP(s) DIRECT_MMAP_DEFAULT(s) #endif /* DIRECT_MMAP */ #else /* HAVE_MMAP */ #define USE_MMAP_BIT (SIZE_T_ZERO) #define MMAP(s) MFAIL #define MUNMAP(a, s) (-1) #define DIRECT_MMAP(s) MFAIL #define CALL_DIRECT_MMAP(s) DIRECT_MMAP(s) #define CALL_MMAP(s) MMAP(s) #define CALL_MUNMAP(a, s) MUNMAP((a), (s)) #endif /* HAVE_MMAP */ /** * Define CALL_MREMAP */ #if HAVE_MMAP && HAVE_MREMAP #ifdef MREMAP #define CALL_MREMAP(addr, osz, nsz, mv) MREMAP((addr), (osz), (nsz), (mv)) #else /* MREMAP */ #define CALL_MREMAP(addr, osz, nsz, mv) MREMAP_DEFAULT((addr), (osz), (nsz), (mv)) #endif /* MREMAP */ #else /* HAVE_MMAP && HAVE_MREMAP */ #define CALL_MREMAP(addr, osz, nsz, mv) MFAIL #endif /* HAVE_MMAP && HAVE_MREMAP */ /* mstate bit set if continguous morecore disabled or failed */ #define USE_NONCONTIGUOUS_BIT (4U) /* segment bit set in create_mspace_with_base */ #define EXTERN_BIT (8U) /* --------------------------- Lock preliminaries ------------------------ */ /* When locks are defined, there is one global lock, plus one per-mspace lock. The global lock_ensures that mparams.magic and other unique mparams values are initialized only once. It also protects sequences of calls to MORECORE. In many cases sys_alloc requires two calls, that should not be interleaved with calls by other threads. This does not protect against direct calls to MORECORE by other threads not using this lock, so there is still code to cope the best we can on interference. Per-mspace locks surround calls to malloc, free, etc. By default, locks are simple non-reentrant mutexes. Because lock-protected regions generally have bounded times, it is OK to use the supplied simple spinlocks. Spinlocks are likely to improve performance for lightly contended applications, but worsen performance under heavy contention. If USE_LOCKS is > 1, the definitions of lock routines here are bypassed, in which case you will need to define the type MLOCK_T, and at least INITIAL_LOCK, DESTROY_LOCK, ACQUIRE_LOCK, RELEASE_LOCK and TRY_LOCK. You must also declare a static MLOCK_T malloc_global_mutex = { initialization values };. */ #if !USE_LOCKS #define USE_LOCK_BIT (0U) #define INITIAL_LOCK(l) (0) #define DESTROY_LOCK(l) (0) #define ACQUIRE_MALLOC_GLOBAL_LOCK() #define RELEASE_MALLOC_GLOBAL_LOCK() #else #if USE_LOCKS > 1 /* ----------------------- User-defined locks ------------------------ */ /* Define your own lock implementation here */ /* #define INITIAL_LOCK(lk) ... */ /* #define DESTROY_LOCK(lk) ... */ /* #define ACQUIRE_LOCK(lk) ... */ /* #define RELEASE_LOCK(lk) ... */ /* #define TRY_LOCK(lk) ... */ /* static MLOCK_T malloc_global_mutex = ... */ #elif USE_SPIN_LOCKS /* First, define CAS_LOCK and CLEAR_LOCK on ints */ /* Note CAS_LOCK defined to return 0 on success */ #if defined(__GNUC__)&& (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 1)) #define CAS_LOCK(sl) __sync_lock_test_and_set(sl, 1) #define CLEAR_LOCK(sl) __sync_lock_release(sl) #elif (defined(__GNUC__) && (defined(__i386__) || defined(__x86_64__))) /* Custom spin locks for older gcc on x86 */ static FORCEINLINE int x86_cas_lock(int *sl) { int ret; int val = 1; int cmp = 0; __asm__ __volatile__ ("lock; cmpxchgl %1, %2" : "=a" (ret) : "r" (val), "m" (*(sl)), "0"(cmp) : "memory", "cc"); return ret; } static FORCEINLINE void x86_clear_lock(int* sl) { assert(*sl != 0); int prev = 0; int ret; __asm__ __volatile__ ("lock; xchgl %0, %1" : "=r" (ret) : "m" (*(sl)), "0"(prev) : "memory"); } #define CAS_LOCK(sl) x86_cas_lock(sl) #define CLEAR_LOCK(sl) x86_clear_lock(sl) #else /* Win32 MSC */ #define CAS_LOCK(sl) interlockedexchange(sl, 1) #define CLEAR_LOCK(sl) interlockedexchange (sl, 0) #endif /* ... gcc spins locks ... */ /* How to yield for a spin lock */ #define SPINS_PER_YIELD 63 #if defined(_MSC_VER) #define SLEEP_EX_DURATION 50 /* delay for yield/sleep */ #define SPIN_LOCK_YIELD SleepEx(SLEEP_EX_DURATION, FALSE) #elif defined (__SVR4) && defined (__sun) /* solaris */ #define SPIN_LOCK_YIELD thr_yield(); #elif !defined(LACKS_SCHED_H) #define SPIN_LOCK_YIELD sched_yield(); #else #define SPIN_LOCK_YIELD #endif /* ... yield ... */ #if !defined(USE_RECURSIVE_LOCKS) || USE_RECURSIVE_LOCKS == 0 /* Plain spin locks use single word (embedded in malloc_states) */ static int spin_acquire_lock(int *sl) { int spins = 0; while (*(volatile int *)sl != 0 || CAS_LOCK(sl)) { if ((++spins & SPINS_PER_YIELD) == 0) { SPIN_LOCK_YIELD; } } return 0; } #define MLOCK_T int #define TRY_LOCK(sl) !CAS_LOCK(sl) #define RELEASE_LOCK(sl) CLEAR_LOCK(sl) #define ACQUIRE_LOCK(sl) (CAS_LOCK(sl)? spin_acquire_lock(sl) : 0) #define INITIAL_LOCK(sl) (*sl = 0) #define DESTROY_LOCK(sl) (0) static MLOCK_T malloc_global_mutex = 0; #else /* USE_RECURSIVE_LOCKS */ /* types for lock owners */ #ifdef WIN32 #define THREAD_ID_T DWORD #define CURRENT_THREAD GetCurrentThreadId() #define EQ_OWNER(X,Y) ((X) == (Y)) #else /* Note: the following assume that pthread_t is a type that can be initialized to (casted) zero. If this is not the case, you will need to somehow redefine these or not use spin locks. */ #define THREAD_ID_T pthread_t #define CURRENT_THREAD pthread_self() #define EQ_OWNER(X,Y) pthread_equal(X, Y) #endif struct malloc_recursive_lock { int sl; unsigned int c; THREAD_ID_T threadid; }; #define MLOCK_T struct malloc_recursive_lock static MLOCK_T malloc_global_mutex = { 0, 0, (THREAD_ID_T)0}; static FORCEINLINE void recursive_release_lock(MLOCK_T *lk) { assert(lk->sl != 0); if (--lk->c == 0) { CLEAR_LOCK(&lk->sl); } } static FORCEINLINE int recursive_acquire_lock(MLOCK_T *lk) { THREAD_ID_T mythreadid = CURRENT_THREAD; int spins = 0; for (;;) { if (*((volatile int *)(&lk->sl)) == 0) { if (!CAS_LOCK(&lk->sl)) { lk->threadid = mythreadid; lk->c = 1; return 0; } } else if (EQ_OWNER(lk->threadid, mythreadid)) { ++lk->c; return 0; } if ((++spins & SPINS_PER_YIELD) == 0) { SPIN_LOCK_YIELD; } } } static FORCEINLINE int recursive_try_lock(MLOCK_T *lk) { THREAD_ID_T mythreadid = CURRENT_THREAD; if (*((volatile int *)(&lk->sl)) == 0) { if (!CAS_LOCK(&lk->sl)) { lk->threadid = mythreadid; lk->c = 1; return 1; } } else if (EQ_OWNER(lk->threadid, mythreadid)) { ++lk->c; return 1; } return 0; } #define RELEASE_LOCK(lk) recursive_release_lock(lk) #define TRY_LOCK(lk) recursive_try_lock(lk) #define ACQUIRE_LOCK(lk) recursive_acquire_lock(lk) #define INITIAL_LOCK(lk) ((lk)->threadid = (THREAD_ID_T)0, (lk)->sl = 0, (lk)->c = 0) #define DESTROY_LOCK(lk) (0) #endif /* USE_RECURSIVE_LOCKS */ #elif defined(WIN32) /* Win32 critical sections */ #define MLOCK_T CRITICAL_SECTION #define ACQUIRE_LOCK(lk) (EnterCriticalSection(lk), 0) #define RELEASE_LOCK(lk) LeaveCriticalSection(lk) #define TRY_LOCK(lk) TryEnterCriticalSection(lk) #define INITIAL_LOCK(lk) (!InitializeCriticalSectionAndSpinCount((lk), 0x80000000|4000)) #define DESTROY_LOCK(lk) (DeleteCriticalSection(lk), 0) #define NEED_GLOBAL_LOCK_INIT static MLOCK_T malloc_global_mutex; static volatile long malloc_global_mutex_status; /* Use spin loop to initialize global lock */ static void init_malloc_global_mutex() { for (;;) { long stat = malloc_global_mutex_status; if (stat > 0) return; /* transition to < 0 while initializing, then to > 0) */ if (stat == 0 && interlockedcompareexchange(&malloc_global_mutex_status, -1, 0) == 0) { InitializeCriticalSection(&malloc_global_mutex); interlockedexchange(&malloc_global_mutex_status,1); return; } SleepEx(0, FALSE); } } #else /* pthreads-based locks */ #define MLOCK_T pthread_mutex_t #define ACQUIRE_LOCK(lk) pthread_mutex_lock(lk) #define RELEASE_LOCK(lk) pthread_mutex_unlock(lk) #define TRY_LOCK(lk) (!pthread_mutex_trylock(lk)) #define INITIAL_LOCK(lk) pthread_init_lock(lk) #define DESTROY_LOCK(lk) pthread_mutex_destroy(lk) #if defined(USE_RECURSIVE_LOCKS) && USE_RECURSIVE_LOCKS != 0 && defined(linux) && !defined(PTHREAD_MUTEX_RECURSIVE) /* Cope with old-style linux recursive lock initialization by adding */ /* skipped internal declaration from pthread.h */ extern int pthread_mutexattr_setkind_np __P ((pthread_mutexattr_t *__attr, int __kind)); #define PTHREAD_MUTEX_RECURSIVE PTHREAD_MUTEX_RECURSIVE_NP #define pthread_mutexattr_settype(x,y) pthread_mutexattr_setkind_np(x,y) #endif /* USE_RECURSIVE_LOCKS ... */ static MLOCK_T malloc_global_mutex = PTHREAD_MUTEX_INITIALIZER; static int pthread_init_lock (MLOCK_T *lk) { pthread_mutexattr_t attr; if (pthread_mutexattr_init(&attr)) return 1; #if defined(USE_RECURSIVE_LOCKS) && USE_RECURSIVE_LOCKS != 0 if (pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE)) return 1; #endif if (pthread_mutex_init(lk, &attr)) return 1; if (pthread_mutexattr_destroy(&attr)) return 1; return 0; } #endif /* ... lock types ... */ /* Common code for all lock types */ #define USE_LOCK_BIT (2U) #ifndef ACQUIRE_MALLOC_GLOBAL_LOCK #define ACQUIRE_MALLOC_GLOBAL_LOCK() ACQUIRE_LOCK(&malloc_global_mutex); #endif #ifndef RELEASE_MALLOC_GLOBAL_LOCK #define RELEASE_MALLOC_GLOBAL_LOCK() RELEASE_LOCK(&malloc_global_mutex); #endif #endif /* USE_LOCKS */ /* ----------------------- Chunk representations ------------------------ */ /* (The following includes lightly edited explanations by Colin Plumb.) The malloc_chunk declaration below is misleading (but accurate and necessary). It declares a "view" into memory allowing access to necessary fields at known offsets from a given base. Chunks of memory are maintained using a `boundary tag' method as originally described by Knuth. (See the paper by Paul Wilson ftp://ftp.cs.utexas.edu/pub/garbage/allocsrv.ps for a survey of such techniques.) Sizes of free chunks are stored both in the front of each chunk and at the end. This makes consolidating fragmented chunks into bigger chunks fast. The head fields also hold bits representing whether chunks are free or in use. Here are some pictures to make it clearer. They are "exploded" to show that the state of a chunk can be thought of as extending from the high 31 bits of the head field of its header through the prev_foot and PINUSE_BIT bit of the following chunk header. A chunk that's in use looks like: chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of previous chunk (if P = 0) | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ |P| | Size of this chunk 1| +-+ mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | | +- -+ | | +- -+ | : +- size - sizeof(size_t) available payload bytes -+ : | chunk-> +- -+ | | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ |1| | Size of next chunk (may or may not be in use) | +-+ mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ And if it's free, it looks like this: chunk-> +- -+ | User payload (must be in use, or we would have merged!) | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ |P| | Size of this chunk 0| +-+ mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Next pointer | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Prev pointer | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | : +- size - sizeof(struct chunk) unused bytes -+ : | chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of this chunk | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ |0| | Size of next chunk (must be in use, or we would have merged)| +-+ mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | : +- User payload -+ : | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ |0| +-+ Note that since we always merge adjacent free chunks, the chunks adjacent to a free chunk must be in use. Given a pointer to a chunk (which can be derived trivially from the payload pointer) we can, in O(1) time, find out whether the adjacent chunks are free, and if so, unlink them from the lists that they are on and merge them with the current chunk. Chunks always begin on even word boundaries, so the mem portion (which is returned to the user) is also on an even word boundary, and thus at least double-word aligned. The P (PINUSE_BIT) bit, stored in the unused low-order bit of the chunk size (which is always a multiple of two words), is an in-use bit for the *previous* chunk. If that bit is *clear*, then the word before the current chunk size contains the previous chunk size, and can be used to find the front of the previous chunk. The very first chunk allocated always has this bit set, preventing access to non-existent (or non-owned) memory. If pinuse is set for any given chunk, then you CANNOT determine the size of the previous chunk, and might even get a memory addressing fault when trying to do so. The C (CINUSE_BIT) bit, stored in the unused second-lowest bit of the chunk size redundantly records whether the current chunk is inuse (unless the chunk is mmapped). This redundancy enables usage checks within free and realloc, and reduces indirection when freeing and consolidating chunks. Each freshly allocated chunk must have both cinuse and pinuse set. That is, each allocated chunk borders either a previously allocated and still in-use chunk, or the base of its memory arena. This is ensured by making all allocations from the `lowest' part of any found chunk. Further, no free chunk physically borders another one, so each free chunk is known to be preceded and followed by either inuse chunks or the ends of memory. Note that the `foot' of the current chunk is actually represented as the prev_foot of the NEXT chunk. This makes it easier to deal with alignments etc but can be very confusing when trying to extend or adapt this code. The exceptions to all this are 1. The special chunk `top' is the top-most available chunk (i.e., the one bordering the end of available memory). It is treated specially. Top is never included in any bin, is used only if no other chunk is available, and is released back to the system if it is very large (see M_TRIM_THRESHOLD). In effect, the top chunk is treated as larger (and thus less well fitting) than any other available chunk. The top chunk doesn't update its trailing size field since there is no next contiguous chunk that would have to index off it. However, space is still allocated for it (TOP_FOOT_SIZE) to enable separation or merging when space is extended. 3. Chunks allocated via mmap, have both cinuse and pinuse bits cleared in their head fields. Because they are allocated one-by-one, each must carry its own prev_foot field, which is also used to hold the offset this chunk has within its mmapped region, which is needed to preserve alignment. Each mmapped chunk is trailed by the first two fields of a fake next-chunk for sake of usage checks. */ struct malloc_chunk { size_t prev_foot; /* Size of previous chunk (if free). */ size_t head; /* Size and inuse bits. */ struct malloc_chunk* fd; /* double links -- used only if free. */ struct malloc_chunk* bk; }; typedef struct malloc_chunk mchunk; typedef struct malloc_chunk* mchunkptr; typedef struct malloc_chunk* sbinptr; /* The type of bins of chunks */ typedef unsigned int bindex_t; /* Described below */ typedef unsigned int binmap_t; /* Described below */ typedef unsigned int flag_t; /* The type of various bit flag sets */ /* ------------------- Chunks sizes and alignments ----------------------- */ #define MCHUNK_SIZE (sizeof(mchunk)) #if FOOTERS #define CHUNK_OVERHEAD (TWO_SIZE_T_SIZES) #else /* FOOTERS */ #define CHUNK_OVERHEAD (SIZE_T_SIZE) #endif /* FOOTERS */ /* MMapped chunks need a second word of overhead ... */ #define MMAP_CHUNK_OVERHEAD (TWO_SIZE_T_SIZES) /* ... and additional padding for fake next-chunk at foot */ #define MMAP_FOOT_PAD (FOUR_SIZE_T_SIZES) /* The smallest size we can malloc is an aligned minimal chunk */ #define MIN_CHUNK_SIZE\ ((MCHUNK_SIZE + CHUNK_ALIGN_MASK) & ~CHUNK_ALIGN_MASK) /* conversion from malloc headers to user pointers, and back */ #define chunk2mem(p) ((void*)((char*)(p) + TWO_SIZE_T_SIZES)) #define mem2chunk(mem) ((mchunkptr)((char*)(mem) - TWO_SIZE_T_SIZES)) /* chunk associated with aligned address A */ #define align_as_chunk(A) (mchunkptr)((A) + align_offset(chunk2mem(A))) /* Bounds on request (not chunk) sizes. */ #define MAX_REQUEST ((-MIN_CHUNK_SIZE) << 2) #define MIN_REQUEST (MIN_CHUNK_SIZE - CHUNK_OVERHEAD - SIZE_T_ONE) /* pad request bytes into a usable size */ #define pad_request(req) \ (((req) + CHUNK_OVERHEAD + CHUNK_ALIGN_MASK) & ~CHUNK_ALIGN_MASK) /* pad request, checking for minimum (but not maximum) */ #define request2size(req) \ (((req) < MIN_REQUEST)? MIN_CHUNK_SIZE : pad_request(req)) /* ------------------ Operations on head and foot fields ----------------- */ /* The head field of a chunk is or'ed with PINUSE_BIT when previous adjacent chunk in use, and or'ed with CINUSE_BIT if this chunk is in use, unless mmapped, in which case both bits are cleared. FLAG4_BIT is not used by this malloc, but might be useful in extensions. */ #define PINUSE_BIT (SIZE_T_ONE) #define CINUSE_BIT (SIZE_T_TWO) #define FLAG4_BIT (SIZE_T_FOUR) #define INUSE_BITS (PINUSE_BIT|CINUSE_BIT) #define FLAG_BITS (PINUSE_BIT|CINUSE_BIT|FLAG4_BIT) /* Head value for fenceposts */ #define FENCEPOST_HEAD (INUSE_BITS|SIZE_T_SIZE) /* extraction of fields from head words */ #define cinuse(p) ((p)->head & CINUSE_BIT) #define pinuse(p) ((p)->head & PINUSE_BIT) #define flag4inuse(p) ((p)->head & FLAG4_BIT) #define is_inuse(p) (((p)->head & INUSE_BITS) != PINUSE_BIT) #define is_mmapped(p) (((p)->head & INUSE_BITS) == 0) #define chunksize(p) ((p)->head & ~(FLAG_BITS)) #define clear_pinuse(p) ((p)->head &= ~PINUSE_BIT) #define set_flag4(p) ((p)->head |= FLAG4_BIT) #define clear_flag4(p) ((p)->head &= ~FLAG4_BIT) /* Treat space at ptr +/- offset as a chunk */ #define chunk_plus_offset(p, s) ((mchunkptr)(((char*)(p)) + (s))) #define chunk_minus_offset(p, s) ((mchunkptr)(((char*)(p)) - (s))) /* Ptr to next or previous physical malloc_chunk. */ #define next_chunk(p) ((mchunkptr)( ((char*)(p)) + ((p)->head & ~FLAG_BITS))) #define prev_chunk(p) ((mchunkptr)( ((char*)(p)) - ((p)->prev_foot) )) /* extract next chunk's pinuse bit */ #define next_pinuse(p) ((next_chunk(p)->head) & PINUSE_BIT) /* Get/set size at footer */ #define get_foot(p, s) (((mchunkptr)((char*)(p) + (s)))->prev_foot) #define set_foot(p, s) (((mchunkptr)((char*)(p) + (s)))->prev_foot = (s)) /* Set size, pinuse bit, and foot */ #define set_size_and_pinuse_of_free_chunk(p, s)\ ((p)->head = (s|PINUSE_BIT), set_foot(p, s)) /* Set size, pinuse bit, foot, and clear next pinuse */ #define set_free_with_pinuse(p, s, n)\ (clear_pinuse(n), set_size_and_pinuse_of_free_chunk(p, s)) /* Get the internal overhead associated with chunk p */ #define overhead_for(p)\ (is_mmapped(p)? MMAP_CHUNK_OVERHEAD : CHUNK_OVERHEAD) /* Return true if malloced space is not necessarily cleared */ #if MMAP_CLEARS #define calloc_must_clear(p) (!is_mmapped(p)) #else /* MMAP_CLEARS */ #define calloc_must_clear(p) (1) #endif /* MMAP_CLEARS */ /* ---------------------- Overlaid data structures ----------------------- */ /* When chunks are not in use, they are treated as nodes of either lists or trees. "Small" chunks are stored in circular doubly-linked lists, and look like this: chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of previous chunk | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ `head:' | Size of chunk, in bytes |P| mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Forward pointer to next chunk in list | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Back pointer to previous chunk in list | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Unused space (may be 0 bytes long) . . . . | nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ `foot:' | Size of chunk, in bytes | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ Larger chunks are kept in a form of bitwise digital trees (aka tries) keyed on chunksizes. Because malloc_tree_chunks are only for free chunks greater than 256 bytes, their size doesn't impose any constraints on user chunk sizes. Each node looks like: chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Size of previous chunk | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ `head:' | Size of chunk, in bytes |P| mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Forward pointer to next chunk of same size | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Back pointer to previous chunk of same size | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Pointer to left child (child[0]) | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Pointer to right child (child[1]) | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Pointer to parent | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | bin index of this chunk | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ | Unused space . . | nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ `foot:' | Size of chunk, in bytes | +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ Each tree holding treenodes is a tree of unique chunk sizes. Chunks of the same size are arranged in a circularly-linked list, with only the oldest chunk (the next to be used, in our FIFO ordering) actually in the tree. (Tree members are distinguished by a non-null parent pointer.) If a chunk with the same size an an existing node is inserted, it is linked off the existing node using pointers that work in the same way as fd/bk pointers of small chunks. Each tree contains a power of 2 sized range of chunk sizes (the smallest is 0x100 <= x < 0x180), which is is divided in half at each tree level, with the chunks in the smaller half of the range (0x100 <= x < 0x140 for the top nose) in the left subtree and the larger half (0x140 <= x < 0x180) in the right subtree. This is, of course, done by inspecting individual bits. Using these rules, each node's left subtree contains all smaller sizes than its right subtree. However, the node at the root of each subtree has no particular ordering relationship to either. (The dividing line between the subtree sizes is based on trie relation.) If we remove the last chunk of a given size from the interior of the tree, we need to replace it with a leaf node. The tree ordering rules permit a node to be replaced by any leaf below it. The smallest chunk in a tree (a common operation in a best-fit allocator) can be found by walking a path to the leftmost leaf in the tree. Unlike a usual binary tree, where we follow left child pointers until we reach a null, here we follow the right child pointer any time the left one is null, until we reach a leaf with both child pointers null. The smallest chunk in the tree will be somewhere along that path. The worst case number of steps to add, find, or remove a node is bounded by the number of bits differentiating chunks within bins. Under current bin calculations, this ranges from 6 up to 21 (for 32 bit sizes) or up to 53 (for 64 bit sizes). The typical case is of course much better. */ struct malloc_tree_chunk { /* The first four fields must be compatible with malloc_chunk */ size_t prev_foot; size_t head; struct malloc_tree_chunk* fd; struct malloc_tree_chunk* bk; struct malloc_tree_chunk* child[2]; struct malloc_tree_chunk* parent; bindex_t index; }; typedef struct malloc_tree_chunk tchunk; typedef struct malloc_tree_chunk* tchunkptr; typedef struct malloc_tree_chunk* tbinptr; /* The type of bins of trees */ /* A little helper macro for trees */ #define leftmost_child(t) ((t)->child[0] != 0? (t)->child[0] : (t)->child[1]) /* ----------------------------- Segments -------------------------------- */ /* Each malloc space may include non-contiguous segments, held in a list headed by an embedded malloc_segment record representing the top-most space. Segments also include flags holding properties of the space. Large chunks that are directly allocated by mmap are not included in this list. They are instead independently created and destroyed without otherwise keeping track of them. Segment management mainly comes into play for spaces allocated by MMAP. Any call to MMAP might or might not return memory that is adjacent to an existing segment. MORECORE normally contiguously extends the current space, so this space is almost always adjacent, which is simpler and faster to deal with. (This is why MORECORE is used preferentially to MMAP when both are available -- see sys_alloc.) When allocating using MMAP, we don't use any of the hinting mechanisms (inconsistently) supported in various implementations of unix mmap, or distinguish reserving from committing memory. Instead, we just ask for space, and exploit contiguity when we get it. It is probably possible to do better than this on some systems, but no general scheme seems to be significantly better. Management entails a simpler variant of the consolidation scheme used for chunks to reduce fragmentation -- new adjacent memory is normally prepended or appended to an existing segment. However, there are limitations compared to chunk consolidation that mostly reflect the fact that segment processing is relatively infrequent (occurring only when getting memory from system) and that we don't expect to have huge numbers of segments: * Segments are not indexed, so traversal requires linear scans. (It would be possible to index these, but is not worth the extra overhead and complexity for most programs on most platforms.) * New segments are only appended to old ones when holding top-most memory; if they cannot be prepended to others, they are held in different segments. Except for the top-most segment of an mstate, each segment record is kept at the tail of its segment. Segments are added by pushing segment records onto the list headed by &mstate.seg for the containing mstate. Segment flags control allocation/merge/deallocation policies: * If EXTERN_BIT set, then we did not allocate this segment, and so should not try to deallocate or merge with others. (This currently holds only for the initial segment passed into create_mspace_with_base.) * If USE_MMAP_BIT set, the segment may be merged with other surrounding mmapped segments and trimmed/de-allocated using munmap. * If neither bit is set, then the segment was obtained using MORECORE so can be merged with surrounding MORECORE'd segments and deallocated/trimmed using MORECORE with negative arguments. */ struct malloc_segment { char* base; /* base address */ size_t size; /* allocated size */ struct malloc_segment* next; /* ptr to next segment */ flag_t sflags; /* mmap and extern flag */ }; #define is_mmapped_segment(S) ((S)->sflags & USE_MMAP_BIT) #define is_extern_segment(S) ((S)->sflags & EXTERN_BIT) typedef struct malloc_segment msegment; typedef struct malloc_segment* msegmentptr; /* ---------------------------- malloc_state ----------------------------- */ /* A malloc_state holds all of the bookkeeping for a space. The main fields are: Top The topmost chunk of the currently active segment. Its size is cached in topsize. The actual size of topmost space is topsize+TOP_FOOT_SIZE, which includes space reserved for adding fenceposts and segment records if necessary when getting more space from the system. The size at which to autotrim top is cached from mparams in trim_check, except that it is disabled if an autotrim fails. Designated victim (dv) This is the preferred chunk for servicing small requests that don't have exact fits. It is normally the chunk split off most recently to service another small request. Its size is cached in dvsize. The link fields of this chunk are not maintained since it is not kept in a bin. SmallBins An array of bin headers for free chunks. These bins hold chunks with sizes less than MIN_LARGE_SIZE bytes. Each bin contains chunks of all the same size, spaced 8 bytes apart. To simplify use in double-linked lists, each bin header acts as a malloc_chunk pointing to the real first node, if it exists (else pointing to itself). This avoids special-casing for headers. But to avoid waste, we allocate only the fd/bk pointers of bins, and then use repositioning tricks to treat these as the fields of a chunk. TreeBins Treebins are pointers to the roots of trees holding a range of sizes. There are 2 equally spaced treebins for each power of two from TREE_SHIFT to TREE_SHIFT+16. The last bin holds anything larger. Bin maps There is one bit map for small bins ("smallmap") and one for treebins ("treemap). Each bin sets its bit when non-empty, and clears the bit when empty. Bit operations are then used to avoid bin-by-bin searching -- nearly all "search" is done without ever looking at bins that won't be selected. The bit maps conservatively use 32 bits per map word, even if on 64bit system. For a good description of some of the bit-based techniques used here, see Henry S. Warren Jr's book "Hacker's Delight" (and supplement at http://hackersdelight.org/). Many of these are intended to reduce the branchiness of paths through malloc etc, as well as to reduce the number of memory locations read or written. Segments A list of segments headed by an embedded malloc_segment record representing the initial space. Address check support The least_addr field is the least address ever obtained from MORECORE or MMAP. Attempted frees and reallocs of any address less than this are trapped (unless INSECURE is defined). Magic tag A cross-check field that should always hold same value as mparams.magic. Max allowed footprint The maximum allowed bytes to allocate from system (zero means no limit) Flags Bits recording whether to use MMAP, locks, or contiguous MORECORE Statistics Each space keeps track of current and maximum system memory obtained via MORECORE or MMAP. Trim support Fields holding the amount of unused topmost memory that should trigger trimming, and a counter to force periodic scanning to release unused non-topmost segments. Locking If USE_LOCKS is defined, the "mutex" lock is acquired and released around every public call using this mspace. Extension support A void* pointer and a size_t field that can be used to help implement extensions to this malloc. */ /* Bin types, widths and sizes */ #define NSMALLBINS (32U) #define NTREEBINS (32U) #define SMALLBIN_SHIFT (3U) #define SMALLBIN_WIDTH (SIZE_T_ONE << SMALLBIN_SHIFT) #define TREEBIN_SHIFT (8U) #define MIN_LARGE_SIZE (SIZE_T_ONE << TREEBIN_SHIFT) #define MAX_SMALL_SIZE (MIN_LARGE_SIZE - SIZE_T_ONE) #define MAX_SMALL_REQUEST (MAX_SMALL_SIZE - CHUNK_ALIGN_MASK - CHUNK_OVERHEAD) struct malloc_state { binmap_t smallmap; binmap_t treemap; size_t dvsize; size_t topsize; char* least_addr; mchunkptr dv; mchunkptr top; size_t trim_check; size_t release_checks; size_t magic; mchunkptr smallbins[(NSMALLBINS+1)*2]; tbinptr treebins[NTREEBINS]; size_t footprint; size_t max_footprint; size_t footprint_limit; /* zero means no limit */ flag_t mflags; #if USE_LOCKS MLOCK_T mutex; /* locate lock among fields that rarely change */ #endif /* USE_LOCKS */ msegment seg; void* extp; /* Unused but available for extensions */ size_t exts; }; typedef struct malloc_state* mstate; /* ------------- Global malloc_state and malloc_params ------------------- */ /* malloc_params holds global properties, including those that can be dynamically set using mallopt. There is a single instance, mparams, initialized in init_mparams. Note that the non-zeroness of "magic" also serves as an initialization flag. */ struct malloc_params { size_t magic; size_t page_size; size_t granularity; size_t mmap_threshold; size_t trim_threshold; flag_t default_mflags; }; static struct malloc_params mparams; /* Ensure mparams initialized */ #define ensure_initialization() (void)(mparams.magic != 0 || init_mparams()) #if !ONLY_MSPACES /* The global malloc_state used for all non-"mspace" calls */ static struct malloc_state _gm_; #define gm (&_gm_) #define is_global(M) ((M) == &_gm_) #endif /* !ONLY_MSPACES */ #define is_initialized(M) ((M)->top != 0) /* -------------------------- system alloc setup ------------------------- */ /* Operations on mflags */ #define use_lock(M) ((M)->mflags & USE_LOCK_BIT) #define enable_lock(M) ((M)->mflags |= USE_LOCK_BIT) #if USE_LOCKS #define disable_lock(M) ((M)->mflags &= ~USE_LOCK_BIT) #else #define disable_lock(M) #endif #define use_mmap(M) ((M)->mflags & USE_MMAP_BIT) #define enable_mmap(M) ((M)->mflags |= USE_MMAP_BIT) #if HAVE_MMAP #define disable_mmap(M) ((M)->mflags &= ~USE_MMAP_BIT) #else #define disable_mmap(M) #endif #define use_noncontiguous(M) ((M)->mflags & USE_NONCONTIGUOUS_BIT) #define disable_contiguous(M) ((M)->mflags |= USE_NONCONTIGUOUS_BIT) #define set_lock(M,L)\ ((M)->mflags = (L)?\ ((M)->mflags | USE_LOCK_BIT) :\ ((M)->mflags & ~USE_LOCK_BIT)) /* page-align a size */ #define page_align(S)\ (((S) + (mparams.page_size - SIZE_T_ONE)) & ~(mparams.page_size - SIZE_T_ONE)) /* granularity-align a size */ #define granularity_align(S)\ (((S) + (mparams.granularity - SIZE_T_ONE))\ & ~(mparams.granularity - SIZE_T_ONE)) /* For mmap, use granularity alignment on windows, else page-align */ #ifdef WIN32 #define mmap_align(S) granularity_align(S) #else #define mmap_align(S) page_align(S) #endif /* For sys_alloc, enough padding to ensure can malloc request on success */ #define SYS_ALLOC_PADDING (TOP_FOOT_SIZE + MALLOC_ALIGNMENT) #define is_page_aligned(S)\ (((size_t)(S) & (mparams.page_size - SIZE_T_ONE)) == 0) #define is_granularity_aligned(S)\ (((size_t)(S) & (mparams.granularity - SIZE_T_ONE)) == 0) /* True if segment S holds address A */ #define segment_holds(S, A)\ ((char*)(A) >= S->base && (char*)(A) < S->base + S->size) /* Return segment holding given address */ static msegmentptr segment_holding(mstate m, char* addr) { msegmentptr sp = &m->seg; for (;;) { if (addr >= sp->base && addr < sp->base + sp->size) return sp; if ((sp = sp->next) == 0) return 0; } } /* Return true if segment contains a segment link */ static int has_segment_link(mstate m, msegmentptr ss) { msegmentptr sp = &m->seg; for (;;) { if ((char*)sp >= ss->base && (char*)sp < ss->base + ss->size) return 1; if ((sp = sp->next) == 0) return 0; } } #ifndef MORECORE_CANNOT_TRIM #define should_trim(M,s) ((s) > (M)->trim_check) #else /* MORECORE_CANNOT_TRIM */ #define should_trim(M,s) (0) #endif /* MORECORE_CANNOT_TRIM */ /* TOP_FOOT_SIZE is padding at the end of a segment, including space that may be needed to place segment records and fenceposts when new noncontiguous segments are added. */ #define TOP_FOOT_SIZE\ (align_offset(chunk2mem(0))+pad_request(sizeof(struct malloc_segment))+MIN_CHUNK_SIZE) /* ------------------------------- Hooks -------------------------------- */ /* PREACTION should be defined to return 0 on success, and nonzero on failure. If you are not using locking, you can redefine these to do anything you like. */ #if USE_LOCKS #define PREACTION(M) ((use_lock(M))? ACQUIRE_LOCK(&(M)->mutex) : 0) #define POSTACTION(M) { if (use_lock(M)) RELEASE_LOCK(&(M)->mutex); } #else /* USE_LOCKS */ #ifndef PREACTION #define PREACTION(M) (0) #endif /* PREACTION */ #ifndef POSTACTION #define POSTACTION(M) #endif /* POSTACTION */ #endif /* USE_LOCKS */ /* CORRUPTION_ERROR_ACTION is triggered upon detected bad addresses. USAGE_ERROR_ACTION is triggered on detected bad frees and reallocs. The argument p is an address that might have triggered the fault. It is ignored by the two predefined actions, but might be useful in custom actions that try to help diagnose errors. */ #if PROCEED_ON_ERROR /* A count of the number of corruption errors causing resets */ int malloc_corruption_error_count; /* default corruption action */ static void reset_on_error(mstate m); #define CORRUPTION_ERROR_ACTION(m) reset_on_error(m) #define USAGE_ERROR_ACTION(m, p) #else /* PROCEED_ON_ERROR */ #ifndef CORRUPTION_ERROR_ACTION #define CORRUPTION_ERROR_ACTION(m) ABORT #endif /* CORRUPTION_ERROR_ACTION */ #ifndef USAGE_ERROR_ACTION #define USAGE_ERROR_ACTION(m,p) ABORT #endif /* USAGE_ERROR_ACTION */ #endif /* PROCEED_ON_ERROR */ /* -------------------------- Debugging setup ---------------------------- */ #if ! DEBUG #define check_free_chunk(M,P) #define check_inuse_chunk(M,P) #define check_malloced_chunk(M,P,N) #define check_mmapped_chunk(M,P) #define check_malloc_state(M) #define check_top_chunk(M,P) #else /* DEBUG */ #define check_free_chunk(M,P) do_check_free_chunk(M,P) #define check_inuse_chunk(M,P) do_check_inuse_chunk(M,P) #define check_top_chunk(M,P) do_check_top_chunk(M,P) #define check_malloced_chunk(M,P,N) do_check_malloced_chunk(M,P,N) #define check_mmapped_chunk(M,P) do_check_mmapped_chunk(M,P) #define check_malloc_state(M) do_check_malloc_state(M) static void do_check_any_chunk(mstate m, mchunkptr p); static void do_check_top_chunk(mstate m, mchunkptr p); static void do_check_mmapped_chunk(mstate m, mchunkptr p); static void do_check_inuse_chunk(mstate m, mchunkptr p); static void do_check_free_chunk(mstate m, mchunkptr p); static void do_check_malloced_chunk(mstate m, void* mem, size_t s); static void do_check_tree(mstate m, tchunkptr t); static void do_check_treebin(mstate m, bindex_t i); static void do_check_smallbin(mstate m, bindex_t i); static void do_check_malloc_state(mstate m); static int bin_find(mstate m, mchunkptr x); static size_t traverse_and_check(mstate m); #endif /* DEBUG */ /* ---------------------------- Indexing Bins ---------------------------- */ #define is_small(s) (((s) >> SMALLBIN_SHIFT) < NSMALLBINS) #define small_index(s) (bindex_t)((s) >> SMALLBIN_SHIFT) #define small_index2size(i) ((i) << SMALLBIN_SHIFT) #define MIN_SMALL_INDEX (small_index(MIN_CHUNK_SIZE)) /* addressing by index. See above about smallbin repositioning */ #define smallbin_at(M, i) ((sbinptr)((char*)&((M)->smallbins[(i)<<1]))) #define treebin_at(M,i) (&((M)->treebins[i])) /* assign tree index for size S to variable I. Use x86 asm if possible */ #if defined(__GNUC__) && (defined(__i386__) || defined(__x86_64__)) #define compute_tree_index(S, I)\ {\ unsigned int X = S >> TREEBIN_SHIFT;\ if (X == 0)\ I = 0;\ else if (X > 0xFFFF)\ I = NTREEBINS-1;\ else {\ unsigned int K = (unsigned) sizeof(X)*__CHAR_BIT__ - 1 - (unsigned) __builtin_clz(X); \ I = (bindex_t)((K << 1) + ((S >> (K + (TREEBIN_SHIFT-1)) & 1)));\ }\ } #elif defined (__INTEL_COMPILER) #define compute_tree_index(S, I)\ {\ size_t X = S >> TREEBIN_SHIFT;\ if (X == 0)\ I = 0;\ else if (X > 0xFFFF)\ I = NTREEBINS-1;\ else {\ unsigned int K = _bit_scan_reverse (X); \ I = (bindex_t)((K << 1) + ((S >> (K + (TREEBIN_SHIFT-1)) & 1)));\ }\ } #elif defined(_MSC_VER) && _MSC_VER>=1300 #define compute_tree_index(S, I)\ {\ size_t X = S >> TREEBIN_SHIFT;\ if (X == 0)\ I = 0;\ else if (X > 0xFFFF)\ I = NTREEBINS-1;\ else {\ unsigned int K;\ _BitScanReverse((DWORD *) &K, (DWORD) X);\ I = (bindex_t)((K << 1) + ((S >> (K + (TREEBIN_SHIFT-1)) & 1)));\ }\ } #else /* GNUC */ #define compute_tree_index(S, I)\ {\ size_t X = S >> TREEBIN_SHIFT;\ if (X == 0)\ I = 0;\ else if (X > 0xFFFF)\ I = NTREEBINS-1;\ else {\ unsigned int Y = (unsigned int)X;\ unsigned int N = ((Y - 0x100) >> 16) & 8;\ unsigned int K = (((Y <<= N) - 0x1000) >> 16) & 4;\ N += K;\ N += K = (((Y <<= K) - 0x4000) >> 16) & 2;\ K = 14 - N + ((Y <<= K) >> 15);\ I = (K << 1) + ((S >> (K + (TREEBIN_SHIFT-1)) & 1));\ }\ } #endif /* GNUC */ /* Bit representing maximum resolved size in a treebin at i */ #define bit_for_tree_index(i) \ (i == NTREEBINS-1)? (SIZE_T_BITSIZE-1) : (((i) >> 1) + TREEBIN_SHIFT - 2) /* Shift placing maximum resolved bit in a treebin at i as sign bit */ #define leftshift_for_tree_index(i) \ ((i == NTREEBINS-1)? 0 : \ ((SIZE_T_BITSIZE-SIZE_T_ONE) - (((i) >> 1) + TREEBIN_SHIFT - 2))) /* The size of the smallest chunk held in bin with index i */ #define minsize_for_tree_index(i) \ ((SIZE_T_ONE << (((i) >> 1) + TREEBIN_SHIFT)) | \ (((size_t)((i) & SIZE_T_ONE)) << (((i) >> 1) + TREEBIN_SHIFT - 1))) /* ------------------------ Operations on bin maps ----------------------- */ /* bit corresponding to given index */ #define idx2bit(i) ((binmap_t)(1) << (i)) /* Mark/Clear bits with given index */ #define mark_smallmap(M,i) ((M)->smallmap |= idx2bit(i)) #define clear_smallmap(M,i) ((M)->smallmap &= ~idx2bit(i)) #define smallmap_is_marked(M,i) ((M)->smallmap & idx2bit(i)) #define mark_treemap(M,i) ((M)->treemap |= idx2bit(i)) #define clear_treemap(M,i) ((M)->treemap &= ~idx2bit(i)) #define treemap_is_marked(M,i) ((M)->treemap & idx2bit(i)) /* isolate the least set bit of a bitmap */ #define least_bit(x) ((x) & -(x)) /* mask with all bits to left of least bit of x on */ #define left_bits(x) ((x<<1) | -(x<<1)) /* mask with all bits to left of or equal to least bit of x on */ #define same_or_left_bits(x) ((x) | -(x)) /* index corresponding to given bit. Use x86 asm if possible */ #if defined(__GNUC__) && (defined(__i386__) || defined(__x86_64__)) #define compute_bit2idx(X, I)\ {\ unsigned int J;\ J = __builtin_ctz(X); \ I = (bindex_t)J;\ } #elif defined (__INTEL_COMPILER) #define compute_bit2idx(X, I)\ {\ unsigned int J;\ J = _bit_scan_forward (X); \ I = (bindex_t)J;\ } #elif defined(_MSC_VER) && _MSC_VER>=1300 #define compute_bit2idx(X, I)\ {\ unsigned int J;\ _BitScanForward((DWORD *) &J, X);\ I = (bindex_t)J;\ } #elif USE_BUILTIN_FFS #define compute_bit2idx(X, I) I = ffs(X)-1 #else #define compute_bit2idx(X, I)\ {\ unsigned int Y = X - 1;\ unsigned int K = Y >> (16-4) & 16;\ unsigned int N = K; Y >>= K;\ N += K = Y >> (8-3) & 8; Y >>= K;\ N += K = Y >> (4-2) & 4; Y >>= K;\ N += K = Y >> (2-1) & 2; Y >>= K;\ N += K = Y >> (1-0) & 1; Y >>= K;\ I = (bindex_t)(N + Y);\ } #endif /* GNUC */ /* ----------------------- Runtime Check Support ------------------------- */ /* For security, the main invariant is that malloc/free/etc never writes to a static address other than malloc_state, unless static malloc_state itself has been corrupted, which cannot occur via malloc (because of these checks). In essence this means that we believe all pointers, sizes, maps etc held in malloc_state, but check all of those linked or offsetted from other embedded data structures. These checks are interspersed with main code in a way that tends to minimize their run-time cost. When FOOTERS is defined, in addition to range checking, we also verify footer fields of inuse chunks, which can be used guarantee that the mstate controlling malloc/free is intact. This is a streamlined version of the approach described by William Robertson et al in "Run-time Detection of Heap-based Overflows" LISA'03 http://www.usenix.org/events/lisa03/tech/robertson.html The footer of an inuse chunk holds the xor of its mstate and a random seed, that is checked upon calls to free() and realloc(). This is (probabalistically) unguessable from outside the program, but can be computed by any code successfully malloc'ing any chunk, so does not itself provide protection against code that has already broken security through some other means. Unlike Robertson et al, we always dynamically check addresses of all offset chunks (previous, next, etc). This turns out to be cheaper than relying on hashes. */ #if !INSECURE /* Check if address a is at least as high as any from MORECORE or MMAP */ #define ok_address(M, a) ((char*)(a) >= (M)->least_addr) /* Check if address of next chunk n is higher than base chunk p */ #define ok_next(p, n) ((char*)(p) < (char*)(n)) /* Check if p has inuse status */ #define ok_inuse(p) is_inuse(p) /* Check if p has its pinuse bit on */ #define ok_pinuse(p) pinuse(p) #else /* !INSECURE */ #define ok_address(M, a) (1) #define ok_next(b, n) (1) #define ok_inuse(p) (1) #define ok_pinuse(p) (1) #endif /* !INSECURE */ #if (FOOTERS && !INSECURE) /* Check if (alleged) mstate m has expected magic field */ #define ok_magic(M) ((M)->magic == mparams.magic) #else /* (FOOTERS && !INSECURE) */ #define ok_magic(M) (1) #endif /* (FOOTERS && !INSECURE) */ /* In gcc, use __builtin_expect to minimize impact of checks */ #if !INSECURE #if defined(__GNUC__) && __GNUC__ >= 3 #define RTCHECK(e) __builtin_expect(e, 1) #else /* GNUC */ #define RTCHECK(e) (e) #endif /* GNUC */ #else /* !INSECURE */ #define RTCHECK(e) (1) #endif /* !INSECURE */ /* macros to set up inuse chunks with or without footers */ #if !FOOTERS #define mark_inuse_foot(M,p,s) /* Macros for setting head/foot of non-mmapped chunks */ /* Set cinuse bit and pinuse bit of next chunk */ #define set_inuse(M,p,s)\ ((p)->head = (((p)->head & PINUSE_BIT)|s|CINUSE_BIT),\ ((mchunkptr)(((char*)(p)) + (s)))->head |= PINUSE_BIT) /* Set cinuse and pinuse of this chunk and pinuse of next chunk */ #define set_inuse_and_pinuse(M,p,s)\ ((p)->head = (s|PINUSE_BIT|CINUSE_BIT),\ ((mchunkptr)(((char*)(p)) + (s)))->head |= PINUSE_BIT) /* Set size, cinuse and pinuse bit of this chunk */ #define set_size_and_pinuse_of_inuse_chunk(M, p, s)\ ((p)->head = (s|PINUSE_BIT|CINUSE_BIT)) #else /* FOOTERS */ /* Set foot of inuse chunk to be xor of mstate and seed */ #define mark_inuse_foot(M,p,s)\ (((mchunkptr)((char*)(p) + (s)))->prev_foot = ((size_t)(M) ^ mparams.magic)) #define get_mstate_for(p)\ ((mstate)(((mchunkptr)((char*)(p) +\ (chunksize(p))))->prev_foot ^ mparams.magic)) #define set_inuse(M,p,s)\ ((p)->head = (((p)->head & PINUSE_BIT)|s|CINUSE_BIT),\ (((mchunkptr)(((char*)(p)) + (s)))->head |= PINUSE_BIT), \ mark_inuse_foot(M,p,s)) #define set_inuse_and_pinuse(M,p,s)\ ((p)->head = (s|PINUSE_BIT|CINUSE_BIT),\ (((mchunkptr)(((char*)(p)) + (s)))->head |= PINUSE_BIT),\ mark_inuse_foot(M,p,s)) #define set_size_and_pinuse_of_inuse_chunk(M, p, s)\ ((p)->head = (s|PINUSE_BIT|CINUSE_BIT),\ mark_inuse_foot(M, p, s)) #endif /* !FOOTERS */ /* ---------------------------- setting mparams -------------------------- */ /* Initialize mparams */ static int init_mparams(void) { #ifdef NEED_GLOBAL_LOCK_INIT if (malloc_global_mutex_status <= 0) init_malloc_global_mutex(); #endif ACQUIRE_MALLOC_GLOBAL_LOCK(); if (mparams.magic == 0) { size_t magic; size_t psize; size_t gsize; #ifndef WIN32 psize = malloc_getpagesize; gsize = ((DEFAULT_GRANULARITY != 0)? DEFAULT_GRANULARITY : psize); #else /* WIN32 */ { SYSTEM_INFO system_info; GetSystemInfo(&system_info); psize = system_info.dwPageSize; gsize = ((DEFAULT_GRANULARITY != 0)? DEFAULT_GRANULARITY : system_info.dwAllocationGranularity); } #endif /* WIN32 */ /* Sanity-check configuration: size_t must be unsigned and as wide as pointer type. ints must be at least 4 bytes. alignment must be at least 8. Alignment, min chunk size, and page size must all be powers of 2. */ if ((sizeof(size_t) != sizeof(char*)) || (MAX_SIZE_T < MIN_CHUNK_SIZE) || (sizeof(int) < 4) || (MALLOC_ALIGNMENT < (size_t)8U) || ((MALLOC_ALIGNMENT & (MALLOC_ALIGNMENT-SIZE_T_ONE)) != 0) || ((MCHUNK_SIZE & (MCHUNK_SIZE-SIZE_T_ONE)) != 0) || ((gsize & (gsize-SIZE_T_ONE)) != 0) || ((psize & (psize-SIZE_T_ONE)) != 0)) ABORT; mparams.granularity = gsize; mparams.page_size = psize; mparams.mmap_threshold = DEFAULT_MMAP_THRESHOLD; mparams.trim_threshold = DEFAULT_TRIM_THRESHOLD; #if MORECORE_CONTIGUOUS mparams.default_mflags = USE_LOCK_BIT|USE_MMAP_BIT; #else /* MORECORE_CONTIGUOUS */ mparams.default_mflags = USE_LOCK_BIT|USE_MMAP_BIT|USE_NONCONTIGUOUS_BIT; #endif /* MORECORE_CONTIGUOUS */ #if !ONLY_MSPACES /* Set up lock for main malloc area */ gm->mflags = mparams.default_mflags; (void)INITIAL_LOCK(&gm->mutex); #endif { #if USE_DEV_RANDOM int fd; unsigned char buf[sizeof(size_t)]; /* Try to use /dev/urandom, else fall back on using time */ if ((fd = open("/dev/urandom", O_RDONLY)) >= 0 && read(fd, buf, sizeof(buf)) == sizeof(buf)) { magic = *((size_t *) buf); close(fd); } else #endif /* USE_DEV_RANDOM */ #ifdef WIN32 magic = (size_t)(GetTickCount() ^ (size_t)0x55555555U); #elif defined(LACKS_TIME_H) magic = (size_t)&magic ^ (size_t)0x55555555U; #else magic = (size_t)(time(0) ^ (size_t)0x55555555U); #endif magic |= (size_t)8U; /* ensure nonzero */ magic &= ~(size_t)7U; /* improve chances of fault for bad values */ /* Until memory modes commonly available, use volatile-write */ (*(volatile size_t *)(&(mparams.magic))) = magic; } } RELEASE_MALLOC_GLOBAL_LOCK(); return 1; } /* support for mallopt */ static int change_mparam(int param_number, int value) { size_t val; ensure_initialization(); val = (value == -1)? MAX_SIZE_T : (size_t)value; switch(param_number) { case M_TRIM_THRESHOLD: mparams.trim_threshold = val; return 1; case M_GRANULARITY: if (val >= mparams.page_size && ((val & (val-1)) == 0)) { mparams.granularity = val; return 1; } else return 0; case M_MMAP_THRESHOLD: mparams.mmap_threshold = val; return 1; default: return 0; } } #if DEBUG /* ------------------------- Debugging Support --------------------------- */ /* Check properties of any chunk, whether free, inuse, mmapped etc */ static void do_check_any_chunk(mstate m, mchunkptr p) { assert((is_aligned(chunk2mem(p))) || (p->head == FENCEPOST_HEAD)); assert(ok_address(m, p)); } /* Check properties of top chunk */ static void do_check_top_chunk(mstate m, mchunkptr p) { msegmentptr sp = segment_holding(m, (char*)p); size_t sz = p->head & ~INUSE_BITS; /* third-lowest bit can be set! */ assert(sp != 0); assert((is_aligned(chunk2mem(p))) || (p->head == FENCEPOST_HEAD)); assert(ok_address(m, p)); assert(sz == m->topsize); assert(sz > 0); assert(sz == ((sp->base + sp->size) - (char*)p) - TOP_FOOT_SIZE); assert(pinuse(p)); assert(!pinuse(chunk_plus_offset(p, sz))); } /* Check properties of (inuse) mmapped chunks */ static void do_check_mmapped_chunk(mstate m, mchunkptr p) { size_t sz = chunksize(p); size_t len = (sz + (p->prev_foot) + MMAP_FOOT_PAD); assert(is_mmapped(p)); assert(use_mmap(m)); assert((is_aligned(chunk2mem(p))) || (p->head == FENCEPOST_HEAD)); assert(ok_address(m, p)); assert(!is_small(sz)); assert((len & (mparams.page_size-SIZE_T_ONE)) == 0); assert(chunk_plus_offset(p, sz)->head == FENCEPOST_HEAD); assert(chunk_plus_offset(p, sz+SIZE_T_SIZE)->head == 0); } /* Check properties of inuse chunks */ static void do_check_inuse_chunk(mstate m, mchunkptr p) { do_check_any_chunk(m, p); assert(is_inuse(p)); assert(next_pinuse(p)); /* If not pinuse and not mmapped, previous chunk has OK offset */ assert(is_mmapped(p) || pinuse(p) || next_chunk(prev_chunk(p)) == p); if (is_mmapped(p)) do_check_mmapped_chunk(m, p); } /* Check properties of free chunks */ static void do_check_free_chunk(mstate m, mchunkptr p) { size_t sz = chunksize(p); mchunkptr next = chunk_plus_offset(p, sz); do_check_any_chunk(m, p); assert(!is_inuse(p)); assert(!next_pinuse(p)); assert (!is_mmapped(p)); if (p != m->dv && p != m->top) { if (sz >= MIN_CHUNK_SIZE) { assert((sz & CHUNK_ALIGN_MASK) == 0); assert(is_aligned(chunk2mem(p))); assert(next->prev_foot == sz); assert(pinuse(p)); assert (next == m->top || is_inuse(next)); assert(p->fd->bk == p); assert(p->bk->fd == p); } else /* markers are always of size SIZE_T_SIZE */ assert(sz == SIZE_T_SIZE); } } /* Check properties of malloced chunks at the point they are malloced */ static void do_check_malloced_chunk(mstate m, void* mem, size_t s) { if (mem != 0) { mchunkptr p = mem2chunk(mem); size_t sz = p->head & ~INUSE_BITS; do_check_inuse_chunk(m, p); assert((sz & CHUNK_ALIGN_MASK) == 0); assert(sz >= MIN_CHUNK_SIZE); assert(sz >= s); /* unless mmapped, size is less than MIN_CHUNK_SIZE more than request */ assert(is_mmapped(p) || sz < (s + MIN_CHUNK_SIZE)); } } /* Check a tree and its subtrees. */ static void do_check_tree(mstate m, tchunkptr t) { tchunkptr head = 0; tchunkptr u = t; bindex_t tindex = t->index; size_t tsize = chunksize(t); bindex_t idx; compute_tree_index(tsize, idx); assert(tindex == idx); assert(tsize >= MIN_LARGE_SIZE); assert(tsize >= minsize_for_tree_index(idx)); assert((idx == NTREEBINS-1) || (tsize < minsize_for_tree_index((idx+1)))); do { /* traverse through chain of same-sized nodes */ do_check_any_chunk(m, ((mchunkptr)u)); assert(u->index == tindex); assert(chunksize(u) == tsize); assert(!is_inuse(u)); assert(!next_pinuse(u)); assert(u->fd->bk == u); assert(u->bk->fd == u); if (u->parent == 0) { assert(u->child[0] == 0); assert(u->child[1] == 0); } else { assert(head == 0); /* only one node on chain has parent */ head = u; assert(u->parent != u); assert (u->parent->child[0] == u || u->parent->child[1] == u || *((tbinptr*)(u->parent)) == u); if (u->child[0] != 0) { assert(u->child[0]->parent == u); assert(u->child[0] != u); do_check_tree(m, u->child[0]); } if (u->child[1] != 0) { assert(u->child[1]->parent == u); assert(u->child[1] != u); do_check_tree(m, u->child[1]); } if (u->child[0] != 0 && u->child[1] != 0) { assert(chunksize(u->child[0]) < chunksize(u->child[1])); } } u = u->fd; } while (u != t); assert(head != 0); } /* Check all the chunks in a treebin. */ static void do_check_treebin(mstate m, bindex_t i) { tbinptr* tb = treebin_at(m, i); tchunkptr t = *tb; int empty = (m->treemap & (1U << i)) == 0; if (t == 0) assert(empty); if (!empty) do_check_tree(m, t); } /* Check all the chunks in a smallbin. */ static void do_check_smallbin(mstate m, bindex_t i) { sbinptr b = smallbin_at(m, i); mchunkptr p = b->bk; unsigned int empty = (m->smallmap & (1U << i)) == 0; if (p == b) assert(empty); if (!empty) { for (; p != b; p = p->bk) { size_t size = chunksize(p); mchunkptr q; /* each chunk claims to be free */ do_check_free_chunk(m, p); /* chunk belongs in bin */ assert(small_index(size) == i); assert(p->bk == b || chunksize(p->bk) == chunksize(p)); /* chunk is followed by an inuse chunk */ q = next_chunk(p); if (q->head != FENCEPOST_HEAD) do_check_inuse_chunk(m, q); } } } /* Find x in a bin. Used in other check functions. */ static int bin_find(mstate m, mchunkptr x) { size_t size = chunksize(x); if (is_small(size)) { bindex_t sidx = small_index(size); sbinptr b = smallbin_at(m, sidx); if (smallmap_is_marked(m, sidx)) { mchunkptr p = b; do { if (p == x) return 1; } while ((p = p->fd) != b); } } else { bindex_t tidx; compute_tree_index(size, tidx); if (treemap_is_marked(m, tidx)) { tchunkptr t = *treebin_at(m, tidx); size_t sizebits = size << leftshift_for_tree_index(tidx); while (t != 0 && chunksize(t) != size) { t = t->child[(sizebits >> (SIZE_T_BITSIZE-SIZE_T_ONE)) & 1]; sizebits <<= 1; } if (t != 0) { tchunkptr u = t; do { if (u == (tchunkptr)x) return 1; } while ((u = u->fd) != t); } } } return 0; } /* Traverse each chunk and check it; return total */ static size_t traverse_and_check(mstate m) { size_t sum = 0; if (is_initialized(m)) { msegmentptr s = &m->seg; sum += m->topsize + TOP_FOOT_SIZE; while (s != 0) { mchunkptr q = align_as_chunk(s->base); mchunkptr lastq = 0; assert(pinuse(q)); while (segment_holds(s, q) && q != m->top && q->head != FENCEPOST_HEAD) { sum += chunksize(q); if (is_inuse(q)) { assert(!bin_find(m, q)); do_check_inuse_chunk(m, q); } else { assert(q == m->dv || bin_find(m, q)); assert(lastq == 0 || is_inuse(lastq)); /* Not 2 consecutive free */ do_check_free_chunk(m, q); } lastq = q; q = next_chunk(q); } s = s->next; } } return sum; } /* Check all properties of malloc_state. */ static void do_check_malloc_state(mstate m) { bindex_t i; size_t total; /* check bins */ for (i = 0; i < NSMALLBINS; ++i) do_check_smallbin(m, i); for (i = 0; i < NTREEBINS; ++i) do_check_treebin(m, i); if (m->dvsize != 0) { /* check dv chunk */ do_check_any_chunk(m, m->dv); assert(m->dvsize == chunksize(m->dv)); assert(m->dvsize >= MIN_CHUNK_SIZE); assert(bin_find(m, m->dv) == 0); } if (m->top != 0) { /* check top chunk */ do_check_top_chunk(m, m->top); /*assert(m->topsize == chunksize(m->top)); redundant */ assert(m->topsize > 0); assert(bin_find(m, m->top) == 0); } total = traverse_and_check(m); assert(total <= m->footprint); assert(m->footprint <= m->max_footprint); } #endif /* DEBUG */ /* ----------------------------- statistics ------------------------------ */ #if !NO_MALLINFO static struct mallinfo internal_mallinfo(mstate m) { struct mallinfo nm = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; ensure_initialization(); if (!PREACTION(m)) { check_malloc_state(m); if (is_initialized(m)) { size_t nfree = SIZE_T_ONE; /* top always free */ size_t mfree = m->topsize + TOP_FOOT_SIZE; size_t sum = mfree; msegmentptr s = &m->seg; while (s != 0) { mchunkptr q = align_as_chunk(s->base); while (segment_holds(s, q) && q != m->top && q->head != FENCEPOST_HEAD) { size_t sz = chunksize(q); sum += sz; if (!is_inuse(q)) { mfree += sz; ++nfree; } q = next_chunk(q); } s = s->next; } nm.arena = sum; nm.ordblks = nfree; nm.hblkhd = m->footprint - sum; nm.usmblks = m->max_footprint; nm.uordblks = m->footprint - mfree; nm.fordblks = mfree; nm.keepcost = m->topsize; } POSTACTION(m); } return nm; } #endif /* !NO_MALLINFO */ #if !NO_MALLOC_STATS static void internal_malloc_stats(mstate m) { ensure_initialization(); if (!PREACTION(m)) { size_t maxfp = 0; size_t fp = 0; size_t used = 0; check_malloc_state(m); if (is_initialized(m)) { msegmentptr s = &m->seg; maxfp = m->max_footprint; fp = m->footprint; used = fp - (m->topsize + TOP_FOOT_SIZE); while (s != 0) { mchunkptr q = align_as_chunk(s->base); while (segment_holds(s, q) && q != m->top && q->head != FENCEPOST_HEAD) { if (!is_inuse(q)) used -= chunksize(q); q = next_chunk(q); } s = s->next; } } POSTACTION(m); /* drop lock */ fprintf(stderr, "max system bytes = %10lu\n", (unsigned long)(maxfp)); fprintf(stderr, "system bytes = %10lu\n", (unsigned long)(fp)); fprintf(stderr, "in use bytes = %10lu\n", (unsigned long)(used)); } } #endif /* NO_MALLOC_STATS */ /* ----------------------- Operations on smallbins ----------------------- */ /* Various forms of linking and unlinking are defined as macros. Even the ones for trees, which are very long but have very short typical paths. This is ugly but reduces reliance on inlining support of compilers. */ /* Link a free chunk into a smallbin */ #define insert_small_chunk(M, P, S) {\ bindex_t I = small_index(S);\ mchunkptr B = smallbin_at(M, I);\ mchunkptr F = B;\ assert(S >= MIN_CHUNK_SIZE);\ if (!smallmap_is_marked(M, I))\ mark_smallmap(M, I);\ else if (RTCHECK(ok_address(M, B->fd)))\ F = B->fd;\ else {\ CORRUPTION_ERROR_ACTION(M);\ }\ B->fd = P;\ F->bk = P;\ P->fd = F;\ P->bk = B;\ } /* Unlink a chunk from a smallbin */ #define unlink_small_chunk(M, P, S) {\ mchunkptr F = P->fd;\ mchunkptr B = P->bk;\ bindex_t I = small_index(S);\ assert(P != B);\ assert(P != F);\ assert(chunksize(P) == small_index2size(I));\ if (RTCHECK(F == smallbin_at(M,I) || (ok_address(M, F) && F->bk == P))) { \ if (B == F) {\ clear_smallmap(M, I);\ }\ else if (RTCHECK(B == smallbin_at(M,I) ||\ (ok_address(M, B) && B->fd == P))) {\ F->bk = B;\ B->fd = F;\ }\ else {\ CORRUPTION_ERROR_ACTION(M);\ }\ }\ else {\ CORRUPTION_ERROR_ACTION(M);\ }\ } /* Unlink the first chunk from a smallbin */ #define unlink_first_small_chunk(M, B, P, I) {\ mchunkptr F = P->fd;\ assert(P != B);\ assert(P != F);\ assert(chunksize(P) == small_index2size(I));\ if (B == F) {\ clear_smallmap(M, I);\ }\ else if (RTCHECK(ok_address(M, F) && F->bk == P)) {\ F->bk = B;\ B->fd = F;\ }\ else {\ CORRUPTION_ERROR_ACTION(M);\ }\ } /* Replace dv node, binning the old one */ /* Used only when dvsize known to be small */ #define replace_dv(M, P, S) {\ size_t DVS = M->dvsize;\ assert(is_small(DVS));\ if (DVS != 0) {\ mchunkptr DV = M->dv;\ insert_small_chunk(M, DV, DVS);\ }\ M->dvsize = S;\ M->dv = P;\ } /* ------------------------- Operations on trees ------------------------- */ /* Insert chunk into tree */ #define insert_large_chunk(M, X, S) {\ tbinptr* H;\ bindex_t I;\ compute_tree_index(S, I);\ H = treebin_at(M, I);\ X->index = I;\ X->child[0] = X->child[1] = 0;\ if (!treemap_is_marked(M, I)) {\ mark_treemap(M, I);\ *H = X;\ X->parent = (tchunkptr)H;\ X->fd = X->bk = X;\ }\ else {\ tchunkptr T = *H;\ size_t K = S << leftshift_for_tree_index(I);\ for (;;) {\ if (chunksize(T) != S) {\ tchunkptr* C = &(T->child[(K >> (SIZE_T_BITSIZE-SIZE_T_ONE)) & 1]);\ K <<= 1;\ if (*C != 0)\ T = *C;\ else if (RTCHECK(ok_address(M, C))) {\ *C = X;\ X->parent = T;\ X->fd = X->bk = X;\ break;\ }\ else {\ CORRUPTION_ERROR_ACTION(M);\ break;\ }\ }\ else {\ tchunkptr F = T->fd;\ if (RTCHECK(ok_address(M, T) && ok_address(M, F))) {\ T->fd = F->bk = X;\ X->fd = F;\ X->bk = T;\ X->parent = 0;\ break;\ }\ else {\ CORRUPTION_ERROR_ACTION(M);\ break;\ }\ }\ }\ }\ } /* Unlink steps: 1. If x is a chained node, unlink it from its same-sized fd/bk links and choose its bk node as its replacement. 2. If x was the last node of its size, but not a leaf node, it must be replaced with a leaf node (not merely one with an open left or right), to make sure that lefts and rights of descendents correspond properly to bit masks. We use the rightmost descendent of x. We could use any other leaf, but this is easy to locate and tends to counteract removal of leftmosts elsewhere, and so keeps paths shorter than minimally guaranteed. This doesn't loop much because on average a node in a tree is near the bottom. 3. If x is the base of a chain (i.e., has parent links) relink x's parent and children to x's replacement (or null if none). */ #define unlink_large_chunk(M, X) {\ tchunkptr XP = X->parent;\ tchunkptr R;\ if (X->bk != X) {\ tchunkptr F = X->fd;\ R = X->bk;\ if (RTCHECK(ok_address(M, F) && F->bk == X && R->fd == X)) {\ F->bk = R;\ R->fd = F;\ }\ else {\ CORRUPTION_ERROR_ACTION(M);\ }\ }\ else {\ tchunkptr* RP;\ if (((R = *(RP = &(X->child[1]))) != 0) ||\ ((R = *(RP = &(X->child[0]))) != 0)) {\ tchunkptr* CP;\ while ((*(CP = &(R->child[1])) != 0) ||\ (*(CP = &(R->child[0])) != 0)) {\ R = *(RP = CP);\ }\ if (RTCHECK(ok_address(M, RP)))\ *RP = 0;\ else {\ CORRUPTION_ERROR_ACTION(M);\ }\ }\ }\ if (XP != 0) {\ tbinptr* H = treebin_at(M, X->index);\ if (X == *H) {\ if ((*H = R) == 0) \ clear_treemap(M, X->index);\ }\ else if (RTCHECK(ok_address(M, XP))) {\ if (XP->child[0] == X) \ XP->child[0] = R;\ else \ XP->child[1] = R;\ }\ else\ CORRUPTION_ERROR_ACTION(M);\ if (R != 0) {\ if (RTCHECK(ok_address(M, R))) {\ tchunkptr C0, C1;\ R->parent = XP;\ if ((C0 = X->child[0]) != 0) {\ if (RTCHECK(ok_address(M, C0))) {\ R->child[0] = C0;\ C0->parent = R;\ }\ else\ CORRUPTION_ERROR_ACTION(M);\ }\ if ((C1 = X->child[1]) != 0) {\ if (RTCHECK(ok_address(M, C1))) {\ R->child[1] = C1;\ C1->parent = R;\ }\ else\ CORRUPTION_ERROR_ACTION(M);\ }\ }\ else\ CORRUPTION_ERROR_ACTION(M);\ }\ }\ } /* Relays to large vs small bin operations */ #define insert_chunk(M, P, S)\ if (is_small(S)) insert_small_chunk(M, P, S)\ else { tchunkptr TP = (tchunkptr)(P); insert_large_chunk(M, TP, S); } #define unlink_chunk(M, P, S)\ if (is_small(S)) unlink_small_chunk(M, P, S)\ else { tchunkptr TP = (tchunkptr)(P); unlink_large_chunk(M, TP); } /* Relays to internal calls to malloc/free from realloc, memalign etc */ #if ONLY_MSPACES #define internal_malloc(m, b) mspace_malloc(m, b) #define internal_free(m, mem) mspace_free(m,mem); #else /* ONLY_MSPACES */ #if MSPACES #define internal_malloc(m, b)\ ((m == gm)? dlmalloc(b) : mspace_malloc(m, b)) #define internal_free(m, mem)\ if (m == gm) dlfree(mem); else mspace_free(m,mem); #else /* MSPACES */ #define internal_malloc(m, b) dlmalloc(b) #define internal_free(m, mem) dlfree(mem) #endif /* MSPACES */ #endif /* ONLY_MSPACES */ /* ----------------------- Direct-mmapping chunks ----------------------- */ /* Directly mmapped chunks are set up with an offset to the start of the mmapped region stored in the prev_foot field of the chunk. This allows reconstruction of the required argument to MUNMAP when freed, and also allows adjustment of the returned chunk to meet alignment requirements (especially in memalign). */ /* Malloc using mmap */ static void* mmap_alloc(mstate m, size_t nb) { size_t mmsize = mmap_align(nb + SIX_SIZE_T_SIZES + CHUNK_ALIGN_MASK); if (m->footprint_limit != 0) { size_t fp = m->footprint + mmsize; if (fp <= m->footprint || fp > m->footprint_limit) return 0; } if (mmsize > nb) { /* Check for wrap around 0 */ char* mm = (char*)(CALL_DIRECT_MMAP(mmsize)); if (mm != CMFAIL) { size_t offset = align_offset(chunk2mem(mm)); size_t psize = mmsize - offset - MMAP_FOOT_PAD; mchunkptr p = (mchunkptr)(mm + offset); p->prev_foot = offset; p->head = psize; mark_inuse_foot(m, p, psize); chunk_plus_offset(p, psize)->head = FENCEPOST_HEAD; chunk_plus_offset(p, psize+SIZE_T_SIZE)->head = 0; if (m->least_addr == 0 || mm < m->least_addr) m->least_addr = mm; if ((m->footprint += mmsize) > m->max_footprint) m->max_footprint = m->footprint; assert(is_aligned(chunk2mem(p))); check_mmapped_chunk(m, p); return chunk2mem(p); } } return 0; } /* Realloc using mmap */ static mchunkptr mmap_resize(mstate m, mchunkptr oldp, size_t nb, int flags) { size_t oldsize = chunksize(oldp); flags = flags; /* placate people compiling -Wunused */ if (is_small(nb)) /* Can't shrink mmap regions below small size */ return 0; /* Keep old chunk if big enough but not too big */ if (oldsize >= nb + SIZE_T_SIZE && (oldsize - nb) <= (mparams.granularity << 1)) return oldp; else { size_t offset = oldp->prev_foot; size_t oldmmsize = oldsize + offset + MMAP_FOOT_PAD; size_t newmmsize = mmap_align(nb + SIX_SIZE_T_SIZES + CHUNK_ALIGN_MASK); char* cp = (char*)CALL_MREMAP((char*)oldp - offset, oldmmsize, newmmsize, flags); if (cp != CMFAIL) { mchunkptr newp = (mchunkptr)(cp + offset); size_t psize = newmmsize - offset - MMAP_FOOT_PAD; newp->head = psize; mark_inuse_foot(m, newp, psize); chunk_plus_offset(newp, psize)->head = FENCEPOST_HEAD; chunk_plus_offset(newp, psize+SIZE_T_SIZE)->head = 0; if (cp < m->least_addr) m->least_addr = cp; if ((m->footprint += newmmsize - oldmmsize) > m->max_footprint) m->max_footprint = m->footprint; check_mmapped_chunk(m, newp); return newp; } } return 0; } /* -------------------------- mspace management -------------------------- */ /* Initialize top chunk and its size */ static void init_top(mstate m, mchunkptr p, size_t psize) { /* Ensure alignment */ size_t offset = align_offset(chunk2mem(p)); p = (mchunkptr)((char*)p + offset); psize -= offset; m->top = p; m->topsize = psize; p->head = psize | PINUSE_BIT; /* set size of fake trailing chunk holding overhead space only once */ chunk_plus_offset(p, psize)->head = TOP_FOOT_SIZE; m->trim_check = mparams.trim_threshold; /* reset on each update */ } /* Initialize bins for a new mstate that is otherwise zeroed out */ static void init_bins(mstate m) { /* Establish circular links for smallbins */ bindex_t i; for (i = 0; i < NSMALLBINS; ++i) { sbinptr bin = smallbin_at(m,i); bin->fd = bin->bk = bin; } } #if PROCEED_ON_ERROR /* default corruption action */ static void reset_on_error(mstate m) { int i; ++malloc_corruption_error_count; /* Reinitialize fields to forget about all memory */ m->smallmap = m->treemap = 0; m->dvsize = m->topsize = 0; m->seg.base = 0; m->seg.size = 0; m->seg.next = 0; m->top = m->dv = 0; for (i = 0; i < NTREEBINS; ++i) *treebin_at(m, i) = 0; init_bins(m); } #endif /* PROCEED_ON_ERROR */ /* Allocate chunk and prepend remainder with chunk in successor base. */ static void* prepend_alloc(mstate m, char* newbase, char* oldbase, size_t nb) { mchunkptr p = align_as_chunk(newbase); mchunkptr oldfirst = align_as_chunk(oldbase); size_t psize = (char*)oldfirst - (char*)p; mchunkptr q = chunk_plus_offset(p, nb); size_t qsize = psize - nb; set_size_and_pinuse_of_inuse_chunk(m, p, nb); assert((char*)oldfirst > (char*)q); assert(pinuse(oldfirst)); assert(qsize >= MIN_CHUNK_SIZE); /* consolidate remainder with first chunk of old base */ if (oldfirst == m->top) { size_t tsize = m->topsize += qsize; m->top = q; q->head = tsize | PINUSE_BIT; check_top_chunk(m, q); } else if (oldfirst == m->dv) { size_t dsize = m->dvsize += qsize; m->dv = q; set_size_and_pinuse_of_free_chunk(q, dsize); } else { if (!is_inuse(oldfirst)) { size_t nsize = chunksize(oldfirst); unlink_chunk(m, oldfirst, nsize); oldfirst = chunk_plus_offset(oldfirst, nsize); qsize += nsize; } set_free_with_pinuse(q, qsize, oldfirst); insert_chunk(m, q, qsize); check_free_chunk(m, q); } check_malloced_chunk(m, chunk2mem(p), nb); return chunk2mem(p); } /* Add a segment to hold a new noncontiguous region */ static void add_segment(mstate m, char* tbase, size_t tsize, flag_t mmapped) { /* Determine locations and sizes of segment, fenceposts, old top */ char* old_top = (char*)m->top; msegmentptr oldsp = segment_holding(m, old_top); char* old_end = oldsp->base + oldsp->size; size_t ssize = pad_request(sizeof(struct malloc_segment)); char* rawsp = old_end - (ssize + FOUR_SIZE_T_SIZES + CHUNK_ALIGN_MASK); size_t offset = align_offset(chunk2mem(rawsp)); char* asp = rawsp + offset; char* csp = (asp < (old_top + MIN_CHUNK_SIZE))? old_top : asp; mchunkptr sp = (mchunkptr)csp; msegmentptr ss = (msegmentptr)(chunk2mem(sp)); mchunkptr tnext = chunk_plus_offset(sp, ssize); mchunkptr p = tnext; int nfences = 0; /* reset top to new space */ init_top(m, (mchunkptr)tbase, tsize - TOP_FOOT_SIZE); /* Set up segment record */ assert(is_aligned(ss)); set_size_and_pinuse_of_inuse_chunk(m, sp, ssize); *ss = m->seg; /* Push current record */ m->seg.base = tbase; m->seg.size = tsize; m->seg.sflags = mmapped; m->seg.next = ss; /* Insert trailing fenceposts */ for (;;) { mchunkptr nextp = chunk_plus_offset(p, SIZE_T_SIZE); p->head = FENCEPOST_HEAD; ++nfences; if ((char*)(&(nextp->head)) < old_end) p = nextp; else break; } assert(nfences >= 2); /* Insert the rest of old top into a bin as an ordinary free chunk */ if (csp != old_top) { mchunkptr q = (mchunkptr)old_top; size_t psize = csp - old_top; mchunkptr tn = chunk_plus_offset(q, psize); set_free_with_pinuse(q, psize, tn); insert_chunk(m, q, psize); } check_top_chunk(m, m->top); } /* -------------------------- System allocation -------------------------- */ /* Get memory from system using MORECORE or MMAP */ static void* sys_alloc(mstate m, size_t nb) { char* tbase = CMFAIL; size_t tsize = 0; flag_t mmap_flag = 0; size_t asize; /* allocation size */ ensure_initialization(); /* Directly map large chunks, but only if already initialized */ if (use_mmap(m) && nb >= mparams.mmap_threshold && m->topsize != 0) { void* mem = mmap_alloc(m, nb); if (mem != 0) return mem; } asize = granularity_align(nb + SYS_ALLOC_PADDING); if (asize <= nb) return 0; /* wraparound */ if (m->footprint_limit != 0) { size_t fp = m->footprint + asize; if (fp <= m->footprint || fp > m->footprint_limit) return 0; } /* Try getting memory in any of three ways (in most-preferred to least-preferred order): 1. A call to MORECORE that can normally contiguously extend memory. (disabled if not MORECORE_CONTIGUOUS or not HAVE_MORECORE or or main space is mmapped or a previous contiguous call failed) 2. A call to MMAP new space (disabled if not HAVE_MMAP). Note that under the default settings, if MORECORE is unable to fulfill a request, and HAVE_MMAP is true, then mmap is used as a noncontiguous system allocator. This is a useful backup strategy for systems with holes in address spaces -- in this case sbrk cannot contiguously expand the heap, but mmap may be able to find space. 3. A call to MORECORE that cannot usually contiguously extend memory. (disabled if not HAVE_MORECORE) In all cases, we need to request enough bytes from system to ensure we can malloc nb bytes upon success, so pad with enough space for top_foot, plus alignment-pad to make sure we don't lose bytes if not on boundary, and round this up to a granularity unit. */ if (MORECORE_CONTIGUOUS && !use_noncontiguous(m)) { char* br = CMFAIL; msegmentptr ss = (m->top == 0)? 0 : segment_holding(m, (char*)m->top); ACQUIRE_MALLOC_GLOBAL_LOCK(); if (ss == 0) { /* First time through or recovery */ char* base = (char*)CALL_MORECORE(0); if (base != CMFAIL) { size_t fp; /* Adjust to end on a page boundary */ if (!is_page_aligned(base)) asize += (page_align((size_t)base) - (size_t)base); fp = m->footprint + asize; /* recheck limits */ if (asize > nb && asize < HALF_MAX_SIZE_T && (m->footprint_limit == 0 || (fp > m->footprint && fp <= m->footprint_limit)) && (br = (char*)(CALL_MORECORE(asize))) == base) { tbase = base; tsize = asize; } } } else { /* Subtract out existing available top space from MORECORE request. */ asize = granularity_align(nb - m->topsize + SYS_ALLOC_PADDING); /* Use mem here only if it did continuously extend old space */ if (asize < HALF_MAX_SIZE_T && (br = (char*)(CALL_MORECORE(asize))) == ss->base+ss->size) { tbase = br; tsize = asize; } } if (tbase == CMFAIL) { /* Cope with partial failure */ if (br != CMFAIL) { /* Try to use/extend the space we did get */ if (asize < HALF_MAX_SIZE_T && asize < nb + SYS_ALLOC_PADDING) { size_t esize = granularity_align(nb + SYS_ALLOC_PADDING - asize); if (esize < HALF_MAX_SIZE_T) { char* end = (char*)CALL_MORECORE(esize); if (end != CMFAIL) asize += esize; else { /* Can't use; try to release */ (void) CALL_MORECORE(-asize); br = CMFAIL; } } } } if (br != CMFAIL) { /* Use the space we did get */ tbase = br; tsize = asize; } else disable_contiguous(m); /* Don't try contiguous path in the future */ } RELEASE_MALLOC_GLOBAL_LOCK(); } if (HAVE_MMAP && tbase == CMFAIL) { /* Try MMAP */ char* mp = (char*)(CALL_MMAP(asize)); if (mp != CMFAIL) { tbase = mp; tsize = asize; mmap_flag = USE_MMAP_BIT; } } if (HAVE_MORECORE && tbase == CMFAIL) { /* Try noncontiguous MORECORE */ if (asize < HALF_MAX_SIZE_T) { char* br = CMFAIL; char* end = CMFAIL; ACQUIRE_MALLOC_GLOBAL_LOCK(); br = (char*)(CALL_MORECORE(asize)); end = (char*)(CALL_MORECORE(0)); RELEASE_MALLOC_GLOBAL_LOCK(); if (br != CMFAIL && end != CMFAIL && br < end) { size_t ssize = end - br; if (ssize > nb + TOP_FOOT_SIZE) { tbase = br; tsize = ssize; } } } } if (tbase != CMFAIL) { if ((m->footprint += tsize) > m->max_footprint) m->max_footprint = m->footprint; if (!is_initialized(m)) { /* first-time initialization */ if (m->least_addr == 0 || tbase < m->least_addr) m->least_addr = tbase; m->seg.base = tbase; m->seg.size = tsize; m->seg.sflags = mmap_flag; m->magic = mparams.magic; m->release_checks = MAX_RELEASE_CHECK_RATE; init_bins(m); #if !ONLY_MSPACES if (is_global(m)) init_top(m, (mchunkptr)tbase, tsize - TOP_FOOT_SIZE); else #endif { /* Offset top by embedded malloc_state */ mchunkptr mn = next_chunk(mem2chunk(m)); init_top(m, mn, (size_t)((tbase + tsize) - (char*)mn) -TOP_FOOT_SIZE); } } else { /* Try to merge with an existing segment */ msegmentptr sp = &m->seg; /* Only consider most recent segment if traversal suppressed */ while (sp != 0 && tbase != sp->base + sp->size) sp = (NO_SEGMENT_TRAVERSAL) ? 0 : sp->next; if (sp != 0 && !is_extern_segment(sp) && (sp->sflags & USE_MMAP_BIT) == mmap_flag && segment_holds(sp, m->top)) { /* append */ sp->size += tsize; init_top(m, m->top, m->topsize + tsize); } else { if (tbase < m->least_addr) m->least_addr = tbase; sp = &m->seg; while (sp != 0 && sp->base != tbase + tsize) sp = (NO_SEGMENT_TRAVERSAL) ? 0 : sp->next; if (sp != 0 && !is_extern_segment(sp) && (sp->sflags & USE_MMAP_BIT) == mmap_flag) { char* oldbase = sp->base; sp->base = tbase; sp->size += tsize; return prepend_alloc(m, tbase, oldbase, nb); } else add_segment(m, tbase, tsize, mmap_flag); } } if (nb < m->topsize) { /* Allocate from new or extended top space */ size_t rsize = m->topsize -= nb; mchunkptr p = m->top; mchunkptr r = m->top = chunk_plus_offset(p, nb); r->head = rsize | PINUSE_BIT; set_size_and_pinuse_of_inuse_chunk(m, p, nb); check_top_chunk(m, m->top); check_malloced_chunk(m, chunk2mem(p), nb); return chunk2mem(p); } } MALLOC_FAILURE_ACTION; return 0; } /* ----------------------- system deallocation -------------------------- */ /* Unmap and unlink any mmapped segments that don't contain used chunks */ static size_t release_unused_segments(mstate m) { size_t released = 0; int nsegs = 0; msegmentptr pred = &m->seg; msegmentptr sp = pred->next; while (sp != 0) { char* base = sp->base; size_t size = sp->size; msegmentptr next = sp->next; ++nsegs; if (is_mmapped_segment(sp) && !is_extern_segment(sp)) { mchunkptr p = align_as_chunk(base); size_t psize = chunksize(p); /* Can unmap if first chunk holds entire segment and not pinned */ if (!is_inuse(p) && (char*)p + psize >= base + size - TOP_FOOT_SIZE) { tchunkptr tp = (tchunkptr)p; assert(segment_holds(sp, (char*)sp)); if (p == m->dv) { m->dv = 0; m->dvsize = 0; } else { unlink_large_chunk(m, tp); } if (CALL_MUNMAP(base, size) == 0) { released += size; m->footprint -= size; /* unlink obsoleted record */ sp = pred; sp->next = next; } else { /* back out if cannot unmap */ insert_large_chunk(m, tp, psize); } } } if (NO_SEGMENT_TRAVERSAL) /* scan only first segment */ break; pred = sp; sp = next; } /* Reset check counter */ m->release_checks = ((nsegs > MAX_RELEASE_CHECK_RATE)? nsegs : MAX_RELEASE_CHECK_RATE); return released; } static int sys_trim(mstate m, size_t pad) { size_t released = 0; ensure_initialization(); if (pad < MAX_REQUEST && is_initialized(m)) { pad += TOP_FOOT_SIZE; /* ensure enough room for segment overhead */ if (m->topsize > pad) { /* Shrink top space in granularity-size units, keeping at least one */ size_t unit = mparams.granularity; size_t extra = ((m->topsize - pad + (unit - SIZE_T_ONE)) / unit - SIZE_T_ONE) * unit; msegmentptr sp = segment_holding(m, (char*)m->top); if (!is_extern_segment(sp)) { if (is_mmapped_segment(sp)) { if (HAVE_MMAP && sp->size >= extra && !has_segment_link(m, sp)) { /* can't shrink if pinned */ size_t newsize = sp->size - extra; /* Prefer mremap, fall back to munmap */ if ((CALL_MREMAP(sp->base, sp->size, newsize, 0) != MFAIL) || (CALL_MUNMAP(sp->base + newsize, extra) == 0)) { released = extra; } } } else if (HAVE_MORECORE) { if (extra >= HALF_MAX_SIZE_T) /* Avoid wrapping negative */ extra = (HALF_MAX_SIZE_T) + SIZE_T_ONE - unit; ACQUIRE_MALLOC_GLOBAL_LOCK(); { /* Make sure end of memory is where we last set it. */ char* old_br = (char*)(CALL_MORECORE(0)); if (old_br == sp->base + sp->size) { char* rel_br = (char*)(CALL_MORECORE(-extra)); char* new_br = (char*)(CALL_MORECORE(0)); if (rel_br != CMFAIL && new_br < old_br) released = old_br - new_br; } } RELEASE_MALLOC_GLOBAL_LOCK(); } } if (released != 0) { sp->size -= released; m->footprint -= released; init_top(m, m->top, m->topsize - released); check_top_chunk(m, m->top); } } /* Unmap any unused mmapped segments */ if (HAVE_MMAP) released += release_unused_segments(m); /* On failure, disable autotrim to avoid repeated failed future calls */ if (released == 0 && m->topsize > m->trim_check) m->trim_check = MAX_SIZE_T; } return (released != 0)? 1 : 0; } /* Consolidate and bin a chunk. Differs from exported versions of free mainly in that the chunk need not be marked as inuse. */ static void dispose_chunk(mstate m, mchunkptr p, size_t psize) { mchunkptr next = chunk_plus_offset(p, psize); if (!pinuse(p)) { mchunkptr prev; size_t prevsize = p->prev_foot; if (is_mmapped(p)) { psize += prevsize + MMAP_FOOT_PAD; if (CALL_MUNMAP((char*)p - prevsize, psize) == 0) m->footprint -= psize; return; } prev = chunk_minus_offset(p, prevsize); psize += prevsize; p = prev; if (RTCHECK(ok_address(m, prev))) { /* consolidate backward */ if (p != m->dv) { unlink_chunk(m, p, prevsize); } else if ((next->head & INUSE_BITS) == INUSE_BITS) { m->dvsize = psize; set_free_with_pinuse(p, psize, next); return; } } else { CORRUPTION_ERROR_ACTION(m); return; } } if (RTCHECK(ok_address(m, next))) { if (!cinuse(next)) { /* consolidate forward */ if (next == m->top) { size_t tsize = m->topsize += psize; m->top = p; p->head = tsize | PINUSE_BIT; if (p == m->dv) { m->dv = 0; m->dvsize = 0; } return; } else if (next == m->dv) { size_t dsize = m->dvsize += psize; m->dv = p; set_size_and_pinuse_of_free_chunk(p, dsize); return; } else { size_t nsize = chunksize(next); psize += nsize; unlink_chunk(m, next, nsize); set_size_and_pinuse_of_free_chunk(p, psize); if (p == m->dv) { m->dvsize = psize; return; } } } else { set_free_with_pinuse(p, psize, next); } insert_chunk(m, p, psize); } else { CORRUPTION_ERROR_ACTION(m); } } /* ---------------------------- malloc --------------------------- */ /* allocate a large request from the best fitting chunk in a treebin */ static void* tmalloc_large(mstate m, size_t nb) { tchunkptr v = 0; size_t rsize = -nb; /* Unsigned negation */ tchunkptr t; bindex_t idx; compute_tree_index(nb, idx); if ((t = *treebin_at(m, idx)) != 0) { /* Traverse tree for this bin looking for node with size == nb */ size_t sizebits = nb << leftshift_for_tree_index(idx); tchunkptr rst = 0; /* The deepest untaken right subtree */ for (;;) { tchunkptr rt; size_t trem = chunksize(t) - nb; if (trem < rsize) { v = t; if ((rsize = trem) == 0) break; } rt = t->child[1]; t = t->child[(sizebits >> (SIZE_T_BITSIZE-SIZE_T_ONE)) & 1]; if (rt != 0 && rt != t) rst = rt; if (t == 0) { t = rst; /* set t to least subtree holding sizes > nb */ break; } sizebits <<= 1; } } if (t == 0 && v == 0) { /* set t to root of next non-empty treebin */ binmap_t leftbits = left_bits(idx2bit(idx)) & m->treemap; if (leftbits != 0) { bindex_t i; binmap_t leastbit = least_bit(leftbits); compute_bit2idx(leastbit, i); t = *treebin_at(m, i); } } while (t != 0) { /* find smallest of tree or subtree */ size_t trem = chunksize(t) - nb; if (trem < rsize) { rsize = trem; v = t; } t = leftmost_child(t); } /* If dv is a better fit, return 0 so malloc will use it */ if (v != 0 && rsize < (size_t)(m->dvsize - nb)) { if (RTCHECK(ok_address(m, v))) { /* split */ mchunkptr r = chunk_plus_offset(v, nb); assert(chunksize(v) == rsize + nb); if (RTCHECK(ok_next(v, r))) { unlink_large_chunk(m, v); if (rsize < MIN_CHUNK_SIZE) set_inuse_and_pinuse(m, v, (rsize + nb)); else { set_size_and_pinuse_of_inuse_chunk(m, v, nb); set_size_and_pinuse_of_free_chunk(r, rsize); insert_chunk(m, r, rsize); } return chunk2mem(v); } } CORRUPTION_ERROR_ACTION(m); } return 0; } /* allocate a small request from the best fitting chunk in a treebin */ static void* tmalloc_small(mstate m, size_t nb) { tchunkptr t, v; size_t rsize; bindex_t i; binmap_t leastbit = least_bit(m->treemap); compute_bit2idx(leastbit, i); v = t = *treebin_at(m, i); rsize = chunksize(t) - nb; while ((t = leftmost_child(t)) != 0) { size_t trem = chunksize(t) - nb; if (trem < rsize) { rsize = trem; v = t; } } if (RTCHECK(ok_address(m, v))) { mchunkptr r = chunk_plus_offset(v, nb); assert(chunksize(v) == rsize + nb); if (RTCHECK(ok_next(v, r))) { unlink_large_chunk(m, v); if (rsize < MIN_CHUNK_SIZE) set_inuse_and_pinuse(m, v, (rsize + nb)); else { set_size_and_pinuse_of_inuse_chunk(m, v, nb); set_size_and_pinuse_of_free_chunk(r, rsize); replace_dv(m, r, rsize); } return chunk2mem(v); } } CORRUPTION_ERROR_ACTION(m); return 0; } #if !ONLY_MSPACES void* dlmalloc(size_t bytes) { /* Basic algorithm: If a small request (< 256 bytes minus per-chunk overhead): 1. If one exists, use a remainderless chunk in associated smallbin. (Remainderless means that there are too few excess bytes to represent as a chunk.) 2. If it is big enough, use the dv chunk, which is normally the chunk adjacent to the one used for the most recent small request. 3. If one exists, split the smallest available chunk in a bin, saving remainder in dv. 4. If it is big enough, use the top chunk. 5. If available, get memory from system and use it Otherwise, for a large request: 1. Find the smallest available binned chunk that fits, and use it if it is better fitting than dv chunk, splitting if necessary. 2. If better fitting than any binned chunk, use the dv chunk. 3. If it is big enough, use the top chunk. 4. If request size >= mmap threshold, try to directly mmap this chunk. 5. If available, get memory from system and use it The ugly goto's here ensure that postaction occurs along all paths. */ #if USE_LOCKS ensure_initialization(); /* initialize in sys_alloc if not using locks */ #endif if (!PREACTION(gm)) { void* mem; size_t nb; if (bytes <= MAX_SMALL_REQUEST) { bindex_t idx; binmap_t smallbits; nb = (bytes < MIN_REQUEST)? MIN_CHUNK_SIZE : pad_request(bytes); idx = small_index(nb); smallbits = gm->smallmap >> idx; if ((smallbits & 0x3U) != 0) { /* Remainderless fit to a smallbin. */ mchunkptr b, p; idx += ~smallbits & 1; /* Uses next bin if idx empty */ b = smallbin_at(gm, idx); p = b->fd; assert(chunksize(p) == small_index2size(idx)); unlink_first_small_chunk(gm, b, p, idx); set_inuse_and_pinuse(gm, p, small_index2size(idx)); mem = chunk2mem(p); check_malloced_chunk(gm, mem, nb); goto postaction; } else if (nb > gm->dvsize) { if (smallbits != 0) { /* Use chunk in next nonempty smallbin */ mchunkptr b, p, r; size_t rsize; bindex_t i; binmap_t leftbits = (smallbits << idx) & left_bits(idx2bit(idx)); binmap_t leastbit = least_bit(leftbits); compute_bit2idx(leastbit, i); b = smallbin_at(gm, i); p = b->fd; assert(chunksize(p) == small_index2size(i)); unlink_first_small_chunk(gm, b, p, i); rsize = small_index2size(i) - nb; /* Fit here cannot be remainderless if 4byte sizes */ if (SIZE_T_SIZE != 4 && rsize < MIN_CHUNK_SIZE) set_inuse_and_pinuse(gm, p, small_index2size(i)); else { set_size_and_pinuse_of_inuse_chunk(gm, p, nb); r = chunk_plus_offset(p, nb); set_size_and_pinuse_of_free_chunk(r, rsize); replace_dv(gm, r, rsize); } mem = chunk2mem(p); check_malloced_chunk(gm, mem, nb); goto postaction; } else if (gm->treemap != 0 && (mem = tmalloc_small(gm, nb)) != 0) { check_malloced_chunk(gm, mem, nb); goto postaction; } } } else if (bytes >= MAX_REQUEST) nb = MAX_SIZE_T; /* Too big to allocate. Force failure (in sys alloc) */ else { nb = pad_request(bytes); if (gm->treemap != 0 && (mem = tmalloc_large(gm, nb)) != 0) { check_malloced_chunk(gm, mem, nb); goto postaction; } } if (nb <= gm->dvsize) { size_t rsize = gm->dvsize - nb; mchunkptr p = gm->dv; if (rsize >= MIN_CHUNK_SIZE) { /* split dv */ mchunkptr r = gm->dv = chunk_plus_offset(p, nb); gm->dvsize = rsize; set_size_and_pinuse_of_free_chunk(r, rsize); set_size_and_pinuse_of_inuse_chunk(gm, p, nb); } else { /* exhaust dv */ size_t dvs = gm->dvsize; gm->dvsize = 0; gm->dv = 0; set_inuse_and_pinuse(gm, p, dvs); } mem = chunk2mem(p); check_malloced_chunk(gm, mem, nb); goto postaction; } else if (nb < gm->topsize) { /* Split top */ size_t rsize = gm->topsize -= nb; mchunkptr p = gm->top; mchunkptr r = gm->top = chunk_plus_offset(p, nb); r->head = rsize | PINUSE_BIT; set_size_and_pinuse_of_inuse_chunk(gm, p, nb); mem = chunk2mem(p); check_top_chunk(gm, gm->top); check_malloced_chunk(gm, mem, nb); goto postaction; } mem = sys_alloc(gm, nb); postaction: POSTACTION(gm); return mem; } return 0; } /* ---------------------------- free --------------------------- */ void dlfree(void* mem) { /* Consolidate freed chunks with preceeding or succeeding bordering free chunks, if they exist, and then place in a bin. Intermixed with special cases for top, dv, mmapped chunks, and usage errors. */ if (mem != 0) { mchunkptr p = mem2chunk(mem); #if FOOTERS mstate fm = get_mstate_for(p); if (!ok_magic(fm)) { USAGE_ERROR_ACTION(fm, p); return; } #else /* FOOTERS */ #define fm gm #endif /* FOOTERS */ if (!PREACTION(fm)) { check_inuse_chunk(fm, p); if (RTCHECK(ok_address(fm, p) && ok_inuse(p))) { size_t psize = chunksize(p); mchunkptr next = chunk_plus_offset(p, psize); if (!pinuse(p)) { size_t prevsize = p->prev_foot; if (is_mmapped(p)) { psize += prevsize + MMAP_FOOT_PAD; if (CALL_MUNMAP((char*)p - prevsize, psize) == 0) fm->footprint -= psize; goto postaction; } else { mchunkptr prev = chunk_minus_offset(p, prevsize); psize += prevsize; p = prev; if (RTCHECK(ok_address(fm, prev))) { /* consolidate backward */ if (p != fm->dv) { unlink_chunk(fm, p, prevsize); } else if ((next->head & INUSE_BITS) == INUSE_BITS) { fm->dvsize = psize; set_free_with_pinuse(p, psize, next); goto postaction; } } else goto erroraction; } } if (RTCHECK(ok_next(p, next) && ok_pinuse(next))) { if (!cinuse(next)) { /* consolidate forward */ if (next == fm->top) { size_t tsize = fm->topsize += psize; fm->top = p; p->head = tsize | PINUSE_BIT; if (p == fm->dv) { fm->dv = 0; fm->dvsize = 0; } if (should_trim(fm, tsize)) sys_trim(fm, 0); goto postaction; } else if (next == fm->dv) { size_t dsize = fm->dvsize += psize; fm->dv = p; set_size_and_pinuse_of_free_chunk(p, dsize); goto postaction; } else { size_t nsize = chunksize(next); psize += nsize; unlink_chunk(fm, next, nsize); set_size_and_pinuse_of_free_chunk(p, psize); if (p == fm->dv) { fm->dvsize = psize; goto postaction; } } } else set_free_with_pinuse(p, psize, next); if (is_small(psize)) { insert_small_chunk(fm, p, psize); check_free_chunk(fm, p); } else { tchunkptr tp = (tchunkptr)p; insert_large_chunk(fm, tp, psize); check_free_chunk(fm, p); if (--fm->release_checks == 0) release_unused_segments(fm); } goto postaction; } } erroraction: USAGE_ERROR_ACTION(fm, p); postaction: POSTACTION(fm); } } #if !FOOTERS #undef fm #endif /* FOOTERS */ } void* dlcalloc(size_t n_elements, size_t elem_size) { void* mem; size_t req = 0; if (n_elements != 0) { req = n_elements * elem_size; if (((n_elements | elem_size) & ~(size_t)0xffff) && (req / n_elements != elem_size)) req = MAX_SIZE_T; /* force downstream failure on overflow */ } mem = dlmalloc(req); if (mem != 0 && calloc_must_clear(mem2chunk(mem))) memset(mem, 0, req); return mem; } #endif /* !ONLY_MSPACES */ /* ------------ Internal support for realloc, memalign, etc -------------- */ /* Try to realloc; only in-place unless can_move true */ static mchunkptr try_realloc_chunk(mstate m, mchunkptr p, size_t nb, int can_move) { mchunkptr newp = 0; size_t oldsize = chunksize(p); mchunkptr next = chunk_plus_offset(p, oldsize); if (RTCHECK(ok_address(m, p) && ok_inuse(p) && ok_next(p, next) && ok_pinuse(next))) { if (is_mmapped(p)) { newp = mmap_resize(m, p, nb, can_move); } else if (oldsize >= nb) { /* already big enough */ size_t rsize = oldsize - nb; if (rsize >= MIN_CHUNK_SIZE) { /* split off remainder */ mchunkptr r = chunk_plus_offset(p, nb); set_inuse(m, p, nb); set_inuse(m, r, rsize); dispose_chunk(m, r, rsize); } newp = p; } else if (next == m->top) { /* extend into top */ if (oldsize + m->topsize > nb) { size_t newsize = oldsize + m->topsize; size_t newtopsize = newsize - nb; mchunkptr newtop = chunk_plus_offset(p, nb); set_inuse(m, p, nb); newtop->head = newtopsize |PINUSE_BIT; m->top = newtop; m->topsize = newtopsize; newp = p; } } else if (next == m->dv) { /* extend into dv */ size_t dvs = m->dvsize; if (oldsize + dvs >= nb) { size_t dsize = oldsize + dvs - nb; if (dsize >= MIN_CHUNK_SIZE) { mchunkptr r = chunk_plus_offset(p, nb); mchunkptr n = chunk_plus_offset(r, dsize); set_inuse(m, p, nb); set_size_and_pinuse_of_free_chunk(r, dsize); clear_pinuse(n); m->dvsize = dsize; m->dv = r; } else { /* exhaust dv */ size_t newsize = oldsize + dvs; set_inuse(m, p, newsize); m->dvsize = 0; m->dv = 0; } newp = p; } } else if (!cinuse(next)) { /* extend into next free chunk */ size_t nextsize = chunksize(next); if (oldsize + nextsize >= nb) { size_t rsize = oldsize + nextsize - nb; unlink_chunk(m, next, nextsize); if (rsize < MIN_CHUNK_SIZE) { size_t newsize = oldsize + nextsize; set_inuse(m, p, newsize); } else { mchunkptr r = chunk_plus_offset(p, nb); set_inuse(m, p, nb); set_inuse(m, r, rsize); dispose_chunk(m, r, rsize); } newp = p; } } } else { USAGE_ERROR_ACTION(m, oldmem); } return newp; } static void* internal_memalign(mstate m, size_t alignment, size_t bytes) { void* mem = 0; if (alignment < MIN_CHUNK_SIZE) /* must be at least a minimum chunk size */ alignment = MIN_CHUNK_SIZE; if ((alignment & (alignment-SIZE_T_ONE)) != 0) {/* Ensure a power of 2 */ size_t a = MALLOC_ALIGNMENT << 1; while (a < alignment) a <<= 1; alignment = a; } if (bytes >= MAX_REQUEST - alignment) { if (m != 0) { /* Test isn't needed but avoids compiler warning */ MALLOC_FAILURE_ACTION; } } else { size_t nb = request2size(bytes); size_t req = nb + alignment + MIN_CHUNK_SIZE - CHUNK_OVERHEAD; mem = internal_malloc(m, req); if (mem != 0) { mchunkptr p = mem2chunk(mem); if (PREACTION(m)) return 0; if ((((size_t)(mem)) & (alignment - 1)) != 0) { /* misaligned */ /* Find an aligned spot inside chunk. Since we need to give back leading space in a chunk of at least MIN_CHUNK_SIZE, if the first calculation places us at a spot with less than MIN_CHUNK_SIZE leader, we can move to the next aligned spot. We've allocated enough total room so that this is always possible. */ char* br = (char*)mem2chunk((size_t)(((size_t)((char*)mem + alignment - SIZE_T_ONE)) & -alignment)); char* pos = ((size_t)(br - (char*)(p)) >= MIN_CHUNK_SIZE)? br : br+alignment; mchunkptr newp = (mchunkptr)pos; size_t leadsize = pos - (char*)(p); size_t newsize = chunksize(p) - leadsize; if (is_mmapped(p)) { /* For mmapped chunks, just adjust offset */ newp->prev_foot = p->prev_foot + leadsize; newp->head = newsize; } else { /* Otherwise, give back leader, use the rest */ set_inuse(m, newp, newsize); set_inuse(m, p, leadsize); dispose_chunk(m, p, leadsize); } p = newp; } /* Give back spare room at the end */ if (!is_mmapped(p)) { size_t size = chunksize(p); if (size > nb + MIN_CHUNK_SIZE) { size_t remainder_size = size - nb; mchunkptr remainder = chunk_plus_offset(p, nb); set_inuse(m, p, nb); set_inuse(m, remainder, remainder_size); dispose_chunk(m, remainder, remainder_size); } } mem = chunk2mem(p); assert (chunksize(p) >= nb); assert(((size_t)mem & (alignment - 1)) == 0); check_inuse_chunk(m, p); POSTACTION(m); } } return mem; } /* Common support for independent_X routines, handling all of the combinations that can result. The opts arg has: bit 0 set if all elements are same size (using sizes[0]) bit 1 set if elements should be zeroed */ static void** ialloc(mstate m, size_t n_elements, size_t* sizes, int opts, void* chunks[]) { size_t element_size; /* chunksize of each element, if all same */ size_t contents_size; /* total size of elements */ size_t array_size; /* request size of pointer array */ void* mem; /* malloced aggregate space */ mchunkptr p; /* corresponding chunk */ size_t remainder_size; /* remaining bytes while splitting */ void** marray; /* either "chunks" or malloced ptr array */ mchunkptr array_chunk; /* chunk for malloced ptr array */ flag_t was_enabled; /* to disable mmap */ size_t size; size_t i; ensure_initialization(); /* compute array length, if needed */ if (chunks != 0) { if (n_elements == 0) return chunks; /* nothing to do */ marray = chunks; array_size = 0; } else { /* if empty req, must still return chunk representing empty array */ if (n_elements == 0) return (void**)internal_malloc(m, 0); marray = 0; array_size = request2size(n_elements * (sizeof(void*))); } /* compute total element size */ if (opts & 0x1) { /* all-same-size */ element_size = request2size(*sizes); contents_size = n_elements * element_size; } else { /* add up all the sizes */ element_size = 0; contents_size = 0; for (i = 0; i != n_elements; ++i) contents_size += request2size(sizes[i]); } size = contents_size + array_size; /* Allocate the aggregate chunk. First disable direct-mmapping so malloc won't use it, since we would not be able to later free/realloc space internal to a segregated mmap region. */ was_enabled = use_mmap(m); disable_mmap(m); mem = internal_malloc(m, size - CHUNK_OVERHEAD); if (was_enabled) enable_mmap(m); if (mem == 0) return 0; if (PREACTION(m)) return 0; p = mem2chunk(mem); remainder_size = chunksize(p); assert(!is_mmapped(p)); if (opts & 0x2) { /* optionally clear the elements */ memset((size_t*)mem, 0, remainder_size - SIZE_T_SIZE - array_size); } /* If not provided, allocate the pointer array as final part of chunk */ if (marray == 0) { size_t array_chunk_size; array_chunk = chunk_plus_offset(p, contents_size); array_chunk_size = remainder_size - contents_size; marray = (void**) (chunk2mem(array_chunk)); set_size_and_pinuse_of_inuse_chunk(m, array_chunk, array_chunk_size); remainder_size = contents_size; } /* split out elements */ for (i = 0; ; ++i) { marray[i] = chunk2mem(p); if (i != n_elements-1) { if (element_size != 0) size = element_size; else size = request2size(sizes[i]); remainder_size -= size; set_size_and_pinuse_of_inuse_chunk(m, p, size); p = chunk_plus_offset(p, size); } else { /* the final element absorbs any overallocation slop */ set_size_and_pinuse_of_inuse_chunk(m, p, remainder_size); break; } } #if DEBUG if (marray != chunks) { /* final element must have exactly exhausted chunk */ if (element_size != 0) { assert(remainder_size == element_size); } else { assert(remainder_size == request2size(sizes[i])); } check_inuse_chunk(m, mem2chunk(marray)); } for (i = 0; i != n_elements; ++i) check_inuse_chunk(m, mem2chunk(marray[i])); #endif /* DEBUG */ POSTACTION(m); return marray; } /* Try to free all pointers in the given array. Note: this could be made faster, by delaying consolidation, at the price of disabling some user integrity checks, We still optimize some consolidations by combining adjacent chunks before freeing, which will occur often if allocated with ialloc or the array is sorted. */ static size_t internal_bulk_free(mstate m, void* array[], size_t nelem) { size_t unfreed = 0; if (!PREACTION(m)) { void** a; void** fence = &(array[nelem]); for (a = array; a != fence; ++a) { void* mem = *a; if (mem != 0) { mchunkptr p = mem2chunk(mem); size_t psize = chunksize(p); #if FOOTERS if (get_mstate_for(p) != m) { ++unfreed; continue; } #endif check_inuse_chunk(m, p); *a = 0; if (RTCHECK(ok_address(m, p) && ok_inuse(p))) { void ** b = a + 1; /* try to merge with next chunk */ mchunkptr next = next_chunk(p); if (b != fence && *b == chunk2mem(next)) { size_t newsize = chunksize(next) + psize; set_inuse(m, p, newsize); *b = chunk2mem(p); } else dispose_chunk(m, p, psize); } else { CORRUPTION_ERROR_ACTION(m); break; } } } if (should_trim(m, m->topsize)) sys_trim(m, 0); POSTACTION(m); } return unfreed; } /* Traversal */ #if MALLOC_INSPECT_ALL static void internal_inspect_all(mstate m, void(*handler)(void *start, void *end, size_t used_bytes, void* callback_arg), void* arg) { if (is_initialized(m)) { mchunkptr top = m->top; msegmentptr s; for (s = &m->seg; s != 0; s = s->next) { mchunkptr q = align_as_chunk(s->base); while (segment_holds(s, q) && q->head != FENCEPOST_HEAD) { mchunkptr next = next_chunk(q); size_t sz = chunksize(q); size_t used; void* start; if (is_inuse(q)) { used = sz - CHUNK_OVERHEAD; /* must not be mmapped */ start = chunk2mem(q); } else { used = 0; if (is_small(sz)) { /* offset by possible bookkeeping */ start = (void*)((char*)q + sizeof(malloc_chunk)); } else { start = (void*)((char*)q + sizeof(malloc_tree_chunk)); } } if (start < (void*)next) /* skip if all space is bookkeeping */ handler(start, next, used, arg); if (q == top) break; q = next; } } } } #endif /* MALLOC_INSPECT_ALL */ /* ------------------ Exported realloc, memalign, etc -------------------- */ #if !ONLY_MSPACES void* dlrealloc(void* oldmem, size_t bytes) { void* mem = 0; if (oldmem == 0) { mem = dlmalloc(bytes); } else if (bytes >= MAX_REQUEST) { MALLOC_FAILURE_ACTION; } #ifdef REALLOC_ZERO_BYTES_FREES else if (bytes == 0) { dlfree(oldmem); } #endif /* REALLOC_ZERO_BYTES_FREES */ else { size_t nb = request2size(bytes); mchunkptr oldp = mem2chunk(oldmem); #if ! FOOTERS mstate m = gm; #else /* FOOTERS */ mstate m = get_mstate_for(oldp); if (!ok_magic(m)) { USAGE_ERROR_ACTION(m, oldmem); return 0; } #endif /* FOOTERS */ if (!PREACTION(m)) { mchunkptr newp = try_realloc_chunk(m, oldp, nb, 1); POSTACTION(m); if (newp != 0) { check_inuse_chunk(m, newp); mem = chunk2mem(newp); } else { mem = internal_malloc(m, bytes); if (mem != 0) { size_t oc = chunksize(oldp) - overhead_for(oldp); memcpy(mem, oldmem, (oc < bytes)? oc : bytes); internal_free(m, oldmem); } } } } return mem; } void* dlrealloc_in_place(void* oldmem, size_t bytes) { void* mem = 0; if (oldmem != 0) { if (bytes >= MAX_REQUEST) { MALLOC_FAILURE_ACTION; } else { size_t nb = request2size(bytes); mchunkptr oldp = mem2chunk(oldmem); #if ! FOOTERS mstate m = gm; #else /* FOOTERS */ mstate m = get_mstate_for(oldp); if (!ok_magic(m)) { USAGE_ERROR_ACTION(m, oldmem); return 0; } #endif /* FOOTERS */ if (!PREACTION(m)) { mchunkptr newp = try_realloc_chunk(m, oldp, nb, 0); POSTACTION(m); if (newp == oldp) { check_inuse_chunk(m, newp); mem = oldmem; } } } } return mem; } void* dlmemalign(size_t alignment, size_t bytes) { if (alignment <= MALLOC_ALIGNMENT) { return dlmalloc(bytes); } return internal_memalign(gm, alignment, bytes); } int dlposix_memalign(void** pp, size_t alignment, size_t bytes) { void* mem = 0; if (alignment == MALLOC_ALIGNMENT) mem = dlmalloc(bytes); else { size_t d = alignment / sizeof(void*); size_t r = alignment % sizeof(void*); if (r != 0 || d == 0 || (d & (d-SIZE_T_ONE)) != 0) return EINVAL; else if (bytes >= MAX_REQUEST - alignment) { if (alignment < MIN_CHUNK_SIZE) alignment = MIN_CHUNK_SIZE; mem = internal_memalign(gm, alignment, bytes); } } if (mem == 0) return ENOMEM; else { *pp = mem; return 0; } } void* dlvalloc(size_t bytes) { size_t pagesz; ensure_initialization(); pagesz = mparams.page_size; return dlmemalign(pagesz, bytes); } void* dlpvalloc(size_t bytes) { size_t pagesz; ensure_initialization(); pagesz = mparams.page_size; return dlmemalign(pagesz, (bytes + pagesz - SIZE_T_ONE) & ~(pagesz - SIZE_T_ONE)); } void** dlindependent_calloc(size_t n_elements, size_t elem_size, void* chunks[]) { size_t sz = elem_size; /* serves as 1-element array */ return ialloc(gm, n_elements, &sz, 3, chunks); } void** dlindependent_comalloc(size_t n_elements, size_t sizes[], void* chunks[]) { return ialloc(gm, n_elements, sizes, 0, chunks); } size_t dlbulk_free(void* array[], size_t nelem) { return internal_bulk_free(gm, array, nelem); } #if MALLOC_INSPECT_ALL void dlmalloc_inspect_all(void(*handler)(void *start, void *end, size_t used_bytes, void* callback_arg), void* arg) { ensure_initialization(); if (!PREACTION(gm)) { internal_inspect_all(gm, handler, arg); POSTACTION(gm); } } #endif /* MALLOC_INSPECT_ALL */ int dlmalloc_trim(size_t pad) { int result = 0; ensure_initialization(); if (!PREACTION(gm)) { result = sys_trim(gm, pad); POSTACTION(gm); } return result; } size_t dlmalloc_footprint(void) { return gm->footprint; } size_t dlmalloc_max_footprint(void) { return gm->max_footprint; } size_t dlmalloc_footprint_limit(void) { size_t maf = gm->footprint_limit; return maf == 0 ? MAX_SIZE_T : maf; } size_t dlmalloc_set_footprint_limit(size_t bytes) { size_t result; /* invert sense of 0 */ if (bytes == 0) result = granularity_align(1); /* Use minimal size */ if (bytes == MAX_SIZE_T) result = 0; /* disable */ else result = granularity_align(bytes); return gm->footprint_limit = result; } #if !NO_MALLINFO struct mallinfo dlmallinfo(void) { return internal_mallinfo(gm); } #endif /* NO_MALLINFO */ #if !NO_MALLOC_STATS void dlmalloc_stats() { internal_malloc_stats(gm); } #endif /* NO_MALLOC_STATS */ int dlmallopt(int param_number, int value) { return change_mparam(param_number, value); } size_t dlmalloc_usable_size(void* mem) { if (mem != 0) { mchunkptr p = mem2chunk(mem); if (is_inuse(p)) return chunksize(p) - overhead_for(p); } return 0; } #endif /* !ONLY_MSPACES */ /* ----------------------------- user mspaces ---------------------------- */ #if MSPACES static mstate init_user_mstate(char* tbase, size_t tsize) { size_t msize = pad_request(sizeof(struct malloc_state)); mchunkptr mn; mchunkptr msp = align_as_chunk(tbase); mstate m = (mstate)(chunk2mem(msp)); memset(m, 0, msize); (void)INITIAL_LOCK(&m->mutex); msp->head = (msize|INUSE_BITS); m->seg.base = m->least_addr = tbase; m->seg.size = m->footprint = m->max_footprint = tsize; m->magic = mparams.magic; m->release_checks = MAX_RELEASE_CHECK_RATE; m->mflags = mparams.default_mflags; m->extp = 0; m->exts = 0; disable_contiguous(m); init_bins(m); mn = next_chunk(mem2chunk(m)); init_top(m, mn, (size_t)((tbase + tsize) - (char*)mn) - TOP_FOOT_SIZE); check_top_chunk(m, m->top); return m; } mspace create_mspace(size_t capacity, int locked) { mstate m = 0; size_t msize; ensure_initialization(); msize = pad_request(sizeof(struct malloc_state)); if (capacity < (size_t) -(msize + TOP_FOOT_SIZE + mparams.page_size)) { size_t rs = ((capacity == 0)? mparams.granularity : (capacity + TOP_FOOT_SIZE + msize)); size_t tsize = granularity_align(rs); char* tbase = (char*)(CALL_MMAP(tsize)); if (tbase != CMFAIL) { m = init_user_mstate(tbase, tsize); m->seg.sflags = USE_MMAP_BIT; set_lock(m, locked); } } return (mspace)m; } mspace create_mspace_with_base(void* base, size_t capacity, int locked) { mstate m = 0; size_t msize; ensure_initialization(); msize = pad_request(sizeof(struct malloc_state)); if (capacity > msize + TOP_FOOT_SIZE && capacity < (size_t) -(msize + TOP_FOOT_SIZE + mparams.page_size)) { m = init_user_mstate((char*)base, capacity); m->seg.sflags = EXTERN_BIT; set_lock(m, locked); } return (mspace)m; } int mspace_track_large_chunks(mspace msp, int enable) { int ret = 0; mstate ms = (mstate)msp; if (!PREACTION(ms)) { if (!use_mmap(ms)) ret = 1; if (!enable) enable_mmap(ms); else disable_mmap(ms); POSTACTION(ms); } return ret; } size_t destroy_mspace(mspace msp) { size_t freed = 0; mstate ms = (mstate)msp; if (ok_magic(ms)) { msegmentptr sp = &ms->seg; (void)DESTROY_LOCK(&ms->mutex); /* destroy before unmapped */ while (sp != 0) { char* base = sp->base; size_t size = sp->size; flag_t flag = sp->sflags; sp = sp->next; if ((flag & USE_MMAP_BIT) && !(flag & EXTERN_BIT) && CALL_MUNMAP(base, size) == 0) freed += size; } } else { USAGE_ERROR_ACTION(ms,ms); } return freed; } /* mspace versions of routines are near-clones of the global versions. This is not so nice but better than the alternatives. */ void* mspace_malloc(mspace msp, size_t bytes) { mstate ms = (mstate)msp; if (!ok_magic(ms)) { USAGE_ERROR_ACTION(ms,ms); return 0; } if (!PREACTION(ms)) { void* mem; size_t nb; if (bytes <= MAX_SMALL_REQUEST) { bindex_t idx; binmap_t smallbits; nb = (bytes < MIN_REQUEST)? MIN_CHUNK_SIZE : pad_request(bytes); idx = small_index(nb); smallbits = ms->smallmap >> idx; if ((smallbits & 0x3U) != 0) { /* Remainderless fit to a smallbin. */ mchunkptr b, p; idx += ~smallbits & 1; /* Uses next bin if idx empty */ b = smallbin_at(ms, idx); p = b->fd; assert(chunksize(p) == small_index2size(idx)); unlink_first_small_chunk(ms, b, p, idx); set_inuse_and_pinuse(ms, p, small_index2size(idx)); mem = chunk2mem(p); check_malloced_chunk(ms, mem, nb); goto postaction; } else if (nb > ms->dvsize) { if (smallbits != 0) { /* Use chunk in next nonempty smallbin */ mchunkptr b, p, r; size_t rsize; bindex_t i; binmap_t leftbits = (smallbits << idx) & left_bits(idx2bit(idx)); binmap_t leastbit = least_bit(leftbits); compute_bit2idx(leastbit, i); b = smallbin_at(ms, i); p = b->fd; assert(chunksize(p) == small_index2size(i)); unlink_first_small_chunk(ms, b, p, i); rsize = small_index2size(i) - nb; /* Fit here cannot be remainderless if 4byte sizes */ if (SIZE_T_SIZE != 4 && rsize < MIN_CHUNK_SIZE) set_inuse_and_pinuse(ms, p, small_index2size(i)); else { set_size_and_pinuse_of_inuse_chunk(ms, p, nb); r = chunk_plus_offset(p, nb); set_size_and_pinuse_of_free_chunk(r, rsize); replace_dv(ms, r, rsize); } mem = chunk2mem(p); check_malloced_chunk(ms, mem, nb); goto postaction; } else if (ms->treemap != 0 && (mem = tmalloc_small(ms, nb)) != 0) { check_malloced_chunk(ms, mem, nb); goto postaction; } } } else if (bytes >= MAX_REQUEST) nb = MAX_SIZE_T; /* Too big to allocate. Force failure (in sys alloc) */ else { nb = pad_request(bytes); if (ms->treemap != 0 && (mem = tmalloc_large(ms, nb)) != 0) { check_malloced_chunk(ms, mem, nb); goto postaction; } } if (nb <= ms->dvsize) { size_t rsize = ms->dvsize - nb; mchunkptr p = ms->dv; if (rsize >= MIN_CHUNK_SIZE) { /* split dv */ mchunkptr r = ms->dv = chunk_plus_offset(p, nb); ms->dvsize = rsize; set_size_and_pinuse_of_free_chunk(r, rsize); set_size_and_pinuse_of_inuse_chunk(ms, p, nb); } else { /* exhaust dv */ size_t dvs = ms->dvsize; ms->dvsize = 0; ms->dv = 0; set_inuse_and_pinuse(ms, p, dvs); } mem = chunk2mem(p); check_malloced_chunk(ms, mem, nb); goto postaction; } else if (nb < ms->topsize) { /* Split top */ size_t rsize = ms->topsize -= nb; mchunkptr p = ms->top; mchunkptr r = ms->top = chunk_plus_offset(p, nb); r->head = rsize | PINUSE_BIT; set_size_and_pinuse_of_inuse_chunk(ms, p, nb); mem = chunk2mem(p); check_top_chunk(ms, ms->top); check_malloced_chunk(ms, mem, nb); goto postaction; } mem = sys_alloc(ms, nb); postaction: POSTACTION(ms); return mem; } return 0; } void mspace_free(mspace msp, void* mem) { if (mem != 0) { mchunkptr p = mem2chunk(mem); #if FOOTERS mstate fm = get_mstate_for(p); msp = msp; /* placate people compiling -Wunused */ #else /* FOOTERS */ mstate fm = (mstate)msp; #endif /* FOOTERS */ if (!ok_magic(fm)) { USAGE_ERROR_ACTION(fm, p); return; } if (!PREACTION(fm)) { check_inuse_chunk(fm, p); if (RTCHECK(ok_address(fm, p) && ok_inuse(p))) { size_t psize = chunksize(p); mchunkptr next = chunk_plus_offset(p, psize); if (!pinuse(p)) { size_t prevsize = p->prev_foot; if (is_mmapped(p)) { psize += prevsize + MMAP_FOOT_PAD; if (CALL_MUNMAP((char*)p - prevsize, psize) == 0) fm->footprint -= psize; goto postaction; } else { mchunkptr prev = chunk_minus_offset(p, prevsize); psize += prevsize; p = prev; if (RTCHECK(ok_address(fm, prev))) { /* consolidate backward */ if (p != fm->dv) { unlink_chunk(fm, p, prevsize); } else if ((next->head & INUSE_BITS) == INUSE_BITS) { fm->dvsize = psize; set_free_with_pinuse(p, psize, next); goto postaction; } } else goto erroraction; } } if (RTCHECK(ok_next(p, next) && ok_pinuse(next))) { if (!cinuse(next)) { /* consolidate forward */ if (next == fm->top) { size_t tsize = fm->topsize += psize; fm->top = p; p->head = tsize | PINUSE_BIT; if (p == fm->dv) { fm->dv = 0; fm->dvsize = 0; } if (should_trim(fm, tsize)) sys_trim(fm, 0); goto postaction; } else if (next == fm->dv) { size_t dsize = fm->dvsize += psize; fm->dv = p; set_size_and_pinuse_of_free_chunk(p, dsize); goto postaction; } else { size_t nsize = chunksize(next); psize += nsize; unlink_chunk(fm, next, nsize); set_size_and_pinuse_of_free_chunk(p, psize); if (p == fm->dv) { fm->dvsize = psize; goto postaction; } } } else set_free_with_pinuse(p, psize, next); if (is_small(psize)) { insert_small_chunk(fm, p, psize); check_free_chunk(fm, p); } else { tchunkptr tp = (tchunkptr)p; insert_large_chunk(fm, tp, psize); check_free_chunk(fm, p); if (--fm->release_checks == 0) release_unused_segments(fm); } goto postaction; } } erroraction: USAGE_ERROR_ACTION(fm, p); postaction: POSTACTION(fm); } } } void* mspace_calloc(mspace msp, size_t n_elements, size_t elem_size) { void* mem; size_t req = 0; mstate ms = (mstate)msp; if (!ok_magic(ms)) { USAGE_ERROR_ACTION(ms,ms); return 0; } if (n_elements != 0) { req = n_elements * elem_size; if (((n_elements | elem_size) & ~(size_t)0xffff) && (req / n_elements != elem_size)) req = MAX_SIZE_T; /* force downstream failure on overflow */ } mem = internal_malloc(ms, req); if (mem != 0 && calloc_must_clear(mem2chunk(mem))) memset(mem, 0, req); return mem; } void* mspace_realloc(mspace msp, void* oldmem, size_t bytes) { void* mem = 0; if (oldmem == 0) { mem = mspace_malloc(msp, bytes); } else if (bytes >= MAX_REQUEST) { MALLOC_FAILURE_ACTION; } #ifdef REALLOC_ZERO_BYTES_FREES else if (bytes == 0) { mspace_free(msp, oldmem); } #endif /* REALLOC_ZERO_BYTES_FREES */ else { size_t nb = request2size(bytes); mchunkptr oldp = mem2chunk(oldmem); #if ! FOOTERS mstate m = (mstate)msp; #else /* FOOTERS */ mstate m = get_mstate_for(oldp); if (!ok_magic(m)) { USAGE_ERROR_ACTION(m, oldmem); return 0; } #endif /* FOOTERS */ if (!PREACTION(m)) { mchunkptr newp = try_realloc_chunk(m, oldp, nb, 1); POSTACTION(m); if (newp != 0) { check_inuse_chunk(m, newp); mem = chunk2mem(newp); } else { mem = mspace_malloc(m, bytes); if (mem != 0) { size_t oc = chunksize(oldp) - overhead_for(oldp); memcpy(mem, oldmem, (oc < bytes)? oc : bytes); mspace_free(m, oldmem); } } } } return mem; } void* mspace_realloc_in_place(mspace msp, void* oldmem, size_t bytes) { void* mem = 0; if (oldmem != 0) { if (bytes >= MAX_REQUEST) { MALLOC_FAILURE_ACTION; } else { size_t nb = request2size(bytes); mchunkptr oldp = mem2chunk(oldmem); #if ! FOOTERS mstate m = (mstate)msp; #else /* FOOTERS */ mstate m = get_mstate_for(oldp); msp = msp; /* placate people compiling -Wunused */ if (!ok_magic(m)) { USAGE_ERROR_ACTION(m, oldmem); return 0; } #endif /* FOOTERS */ if (!PREACTION(m)) { mchunkptr newp = try_realloc_chunk(m, oldp, nb, 0); POSTACTION(m); if (newp == oldp) { check_inuse_chunk(m, newp); mem = oldmem; } } } } return mem; } void* mspace_memalign(mspace msp, size_t alignment, size_t bytes) { mstate ms = (mstate)msp; if (!ok_magic(ms)) { USAGE_ERROR_ACTION(ms,ms); return 0; } if (alignment <= MALLOC_ALIGNMENT) return mspace_malloc(msp, bytes); return internal_memalign(ms, alignment, bytes); } void** mspace_independent_calloc(mspace msp, size_t n_elements, size_t elem_size, void* chunks[]) { size_t sz = elem_size; /* serves as 1-element array */ mstate ms = (mstate)msp; if (!ok_magic(ms)) { USAGE_ERROR_ACTION(ms,ms); return 0; } return ialloc(ms, n_elements, &sz, 3, chunks); } void** mspace_independent_comalloc(mspace msp, size_t n_elements, size_t sizes[], void* chunks[]) { mstate ms = (mstate)msp; if (!ok_magic(ms)) { USAGE_ERROR_ACTION(ms,ms); return 0; } return ialloc(ms, n_elements, sizes, 0, chunks); } size_t mspace_bulk_free(mspace msp, void* array[], size_t nelem) { return internal_bulk_free((mstate)msp, array, nelem); } #if MALLOC_INSPECT_ALL void mspace_inspect_all(mspace msp, void(*handler)(void *start, void *end, size_t used_bytes, void* callback_arg), void* arg) { mstate ms = (mstate)msp; if (ok_magic(ms)) { if (!PREACTION(ms)) { internal_inspect_all(ms, handler, arg); POSTACTION(ms); } } else { USAGE_ERROR_ACTION(ms,ms); } } #endif /* MALLOC_INSPECT_ALL */ int mspace_trim(mspace msp, size_t pad) { int result = 0; mstate ms = (mstate)msp; if (ok_magic(ms)) { if (!PREACTION(ms)) { result = sys_trim(ms, pad); POSTACTION(ms); } } else { USAGE_ERROR_ACTION(ms,ms); } return result; } #if !NO_MALLOC_STATS void mspace_malloc_stats(mspace msp) { mstate ms = (mstate)msp; if (ok_magic(ms)) { internal_malloc_stats(ms); } else { USAGE_ERROR_ACTION(ms,ms); } } #endif /* NO_MALLOC_STATS */ size_t mspace_footprint(mspace msp) { size_t result = 0; mstate ms = (mstate)msp; if (ok_magic(ms)) { result = ms->footprint; } else { USAGE_ERROR_ACTION(ms,ms); } return result; } size_t mspace_max_footprint(mspace msp) { size_t result = 0; mstate ms = (mstate)msp; if (ok_magic(ms)) { result = ms->max_footprint; } else { USAGE_ERROR_ACTION(ms,ms); } return result; } size_t mspace_footprint_limit(mspace msp) { size_t result = 0; mstate ms = (mstate)msp; if (ok_magic(ms)) { size_t maf = ms->footprint_limit; result = (maf == 0) ? MAX_SIZE_T : maf; } else { USAGE_ERROR_ACTION(ms,ms); } return result; } size_t mspace_set_footprint_limit(mspace msp, size_t bytes) { size_t result = 0; mstate ms = (mstate)msp; if (ok_magic(ms)) { if (bytes == 0) result = granularity_align(1); /* Use minimal size */ if (bytes == MAX_SIZE_T) result = 0; /* disable */ else result = granularity_align(bytes); ms->footprint_limit = result; } else { USAGE_ERROR_ACTION(ms,ms); } return result; } #if !NO_MALLINFO struct mallinfo mspace_mallinfo(mspace msp) { mstate ms = (mstate)msp; if (!ok_magic(ms)) { USAGE_ERROR_ACTION(ms,ms); } return internal_mallinfo(ms); } #endif /* NO_MALLINFO */ size_t mspace_usable_size(void* mem) { if (mem != 0) { mchunkptr p = mem2chunk(mem); if (is_inuse(p)) return chunksize(p) - overhead_for(p); } return 0; } int mspace_mallopt(int param_number, int value) { return change_mparam(param_number, value); } #endif /* MSPACES */ /* -------------------- Alternative MORECORE functions ------------------- */ /* Guidelines for creating a custom version of MORECORE: * For best performance, MORECORE should allocate in multiples of pagesize. * MORECORE may allocate more memory than requested. (Or even less, but this will usually result in a malloc failure.) * MORECORE must not allocate memory when given argument zero, but instead return one past the end address of memory from previous nonzero call. * For best performance, consecutive calls to MORECORE with positive arguments should return increasing addresses, indicating that space has been contiguously extended. * Even though consecutive calls to MORECORE need not return contiguous addresses, it must be OK for malloc'ed chunks to span multiple regions in those cases where they do happen to be contiguous. * MORECORE need not handle negative arguments -- it may instead just return MFAIL when given negative arguments. Negative arguments are always multiples of pagesize. MORECORE must not misinterpret negative args as large positive unsigned args. You can suppress all such calls from even occurring by defining MORECORE_CANNOT_TRIM, As an example alternative MORECORE, here is a custom allocator kindly contributed for pre-OSX macOS. It uses virtually but not necessarily physically contiguous non-paged memory (locked in, present and won't get swapped out). You can use it by uncommenting this section, adding some #includes, and setting up the appropriate defines above: #define MORECORE osMoreCore There is also a shutdown routine that should somehow be called for cleanup upon program exit. #define MAX_POOL_ENTRIES 100 #define MINIMUM_MORECORE_SIZE (64 * 1024U) static int next_os_pool; void *our_os_pools[MAX_POOL_ENTRIES]; void *osMoreCore(int size) { void *ptr = 0; static void *sbrk_top = 0; if (size > 0) { if (size < MINIMUM_MORECORE_SIZE) size = MINIMUM_MORECORE_SIZE; if (CurrentExecutionLevel() == kTaskLevel) ptr = PoolAllocateResident(size + RM_PAGE_SIZE, 0); if (ptr == 0) { return (void *) MFAIL; } // save ptrs so they can be freed during cleanup our_os_pools[next_os_pool] = ptr; next_os_pool++; ptr = (void *) ((((size_t) ptr) + RM_PAGE_MASK) & ~RM_PAGE_MASK); sbrk_top = (char *) ptr + size; return ptr; } else if (size < 0) { // we don't currently support shrink behavior return (void *) MFAIL; } else { return sbrk_top; } } // cleanup any allocated memory pools // called as last thing before shutting down driver void osCleanupMem(void) { void **ptr; for (ptr = our_os_pools; ptr < &our_os_pools[MAX_POOL_ENTRIES]; ptr++) if (*ptr) { PoolDeallocate(*ptr); *ptr = 0; } } */ /* ----------------------------------------------------------------------- History: v2.8.5 Sun May 22 10:26:02 2011 Doug Lea (dl at gee) * Always perform unlink checks unless INSECURE * Add posix_memalign. * Improve realloc to expand in more cases; expose realloc_in_place. Thanks to Peter Buhr for the suggestion. * Add footprint_limit, inspect_all, bulk_free. Thanks to Barry Hayes and others for the suggestions. * Internal refactorings to avoid calls while holding locks * Use non-reentrant locks by default. Thanks to Roland McGrath for the suggestion. * Small fixes to mspace_destroy, reset_on_error. * Various configuration extensions/changes. Thanks to all who contributed these. V2.8.4a Thu Apr 28 14:39:43 2011 (dl at gee.cs.oswego.edu) * Update Creative Commons URL V2.8.4 Wed May 27 09:56:23 2009 Doug Lea (dl at gee) * Use zeros instead of prev foot for is_mmapped * Add mspace_track_large_chunks; thanks to Jean Brouwers * Fix set_inuse in internal_realloc; thanks to Jean Brouwers * Fix insufficient sys_alloc padding when using 16byte alignment * Fix bad error check in mspace_footprint * Adaptations for ptmalloc; thanks to Wolfram Gloger. * Reentrant spin locks; thanks to Earl Chew and others * Win32 improvements; thanks to Niall Douglas and Earl Chew * Add NO_SEGMENT_TRAVERSAL and MAX_RELEASE_CHECK_RATE options * Extension hook in malloc_state * Various small adjustments to reduce warnings on some compilers * Various configuration extensions/changes for more platforms. Thanks to all who contributed these. V2.8.3 Thu Sep 22 11:16:32 2005 Doug Lea (dl at gee) * Add max_footprint functions * Ensure all appropriate literals are size_t * Fix conditional compilation problem for some #define settings * Avoid concatenating segments with the one provided in create_mspace_with_base * Rename some variables to avoid compiler shadowing warnings * Use explicit lock initialization. * Better handling of sbrk interference. * Simplify and fix segment insertion, trimming and mspace_destroy * Reinstate REALLOC_ZERO_BYTES_FREES option from 2.7.x * Thanks especially to Dennis Flanagan for help on these. V2.8.2 Sun Jun 12 16:01:10 2005 Doug Lea (dl at gee) * Fix memalign brace error. V2.8.1 Wed Jun 8 16:11:46 2005 Doug Lea (dl at gee) * Fix improper #endif nesting in C++ * Add explicit casts needed for C++ V2.8.0 Mon May 30 14:09:02 2005 Doug Lea (dl at gee) * Use trees for large bins * Support mspaces * Use segments to unify sbrk-based and mmap-based system allocation, removing need for emulation on most platforms without sbrk. * Default safety checks * Optional footer checks. Thanks to William Robertson for the idea. * Internal code refactoring * Incorporate suggestions and platform-specific changes. Thanks to Dennis Flanagan, Colin Plumb, Niall Douglas, Aaron Bachmann, Emery Berger, and others. * Speed up non-fastbin processing enough to remove fastbins. * Remove useless cfree() to avoid conflicts with other apps. * Remove internal memcpy, memset. Compilers handle builtins better. * Remove some options that no one ever used and rename others. V2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee) * Fix malloc_state bitmap array misdeclaration V2.7.1 Thu Jul 25 10:58:03 2002 Doug Lea (dl at gee) * Allow tuning of FIRST_SORTED_BIN_SIZE * Use PTR_UINT as type for all ptr->int casts. Thanks to John Belmonte. * Better detection and support for non-contiguousness of MORECORE. Thanks to Andreas Mueller, Conal Walsh, and Wolfram Gloger * Bypass most of malloc if no frees. Thanks To Emery Berger. * Fix freeing of old top non-contiguous chunk im sysmalloc. * Raised default trim and map thresholds to 256K. * Fix mmap-related #defines. Thanks to Lubos Lunak. * Fix copy macros; added LACKS_FCNTL_H. Thanks to Neal Walfield. * Branch-free bin calculation * Default trim and mmap thresholds now 256K. V2.7.0 Sun Mar 11 14:14:06 2001 Doug Lea (dl at gee) * Introduce independent_comalloc and independent_calloc. Thanks to Michael Pachos for motivation and help. * Make optional .h file available * Allow > 2GB requests on 32bit systems. * new WIN32 sbrk, mmap, munmap, lock code from <Walter@GeNeSys-e.de>. Thanks also to Andreas Mueller <a.mueller at paradatec.de>, and Anonymous. * Allow override of MALLOC_ALIGNMENT (Thanks to Ruud Waij for helping test this.) * memalign: check alignment arg * realloc: don't try to shift chunks backwards, since this leads to more fragmentation in some programs and doesn't seem to help in any others. * Collect all cases in malloc requiring system memory into sysmalloc * Use mmap as backup to sbrk * Place all internal state in malloc_state * Introduce fastbins (although similar to 2.5.1) * Many minor tunings and cosmetic improvements * Introduce USE_PUBLIC_MALLOC_WRAPPERS, USE_MALLOC_LOCK * Introduce MALLOC_FAILURE_ACTION, MORECORE_CONTIGUOUS Thanks to Tony E. Bennett <tbennett@nvidia.com> and others. * Include errno.h to support default failure action. V2.6.6 Sun Dec 5 07:42:19 1999 Doug Lea (dl at gee) * return null for negative arguments * Added Several WIN32 cleanups from Martin C. Fong <mcfong at yahoo.com> * Add 'LACKS_SYS_PARAM_H' for those systems without 'sys/param.h' (e.g. WIN32 platforms) * Cleanup header file inclusion for WIN32 platforms * Cleanup code to avoid Microsoft Visual C++ compiler complaints * Add 'USE_DL_PREFIX' to quickly allow co-existence with existing memory allocation routines * Set 'malloc_getpagesize' for WIN32 platforms (needs more work) * Use 'assert' rather than 'ASSERT' in WIN32 code to conform to usage of 'assert' in non-WIN32 code * Improve WIN32 'sbrk()' emulation's 'findRegion()' routine to avoid infinite loop * Always call 'fREe()' rather than 'free()' V2.6.5 Wed Jun 17 15:57:31 1998 Doug Lea (dl at gee) * Fixed ordering problem with boundary-stamping V2.6.3 Sun May 19 08:17:58 1996 Doug Lea (dl at gee) * Added pvalloc, as recommended by H.J. Liu * Added 64bit pointer support mainly from Wolfram Gloger * Added anonymously donated WIN32 sbrk emulation * Malloc, calloc, getpagesize: add optimizations from Raymond Nijssen * malloc_extend_top: fix mask error that caused wastage after foreign sbrks * Add linux mremap support code from HJ Liu V2.6.2 Tue Dec 5 06:52:55 1995 Doug Lea (dl at gee) * Integrated most documentation with the code. * Add support for mmap, with help from Wolfram Gloger (Gloger@lrz.uni-muenchen.de). * Use last_remainder in more cases. * Pack bins using idea from colin@nyx10.cs.du.edu * Use ordered bins instead of best-fit threshhold * Eliminate block-local decls to simplify tracing and debugging. * Support another case of realloc via move into top * Fix error occuring when initial sbrk_base not word-aligned. * Rely on page size for units instead of SBRK_UNIT to avoid surprises about sbrk alignment conventions. * Add mallinfo, mallopt. Thanks to Raymond Nijssen (raymond@es.ele.tue.nl) for the suggestion. * Add `pad' argument to malloc_trim and top_pad mallopt parameter. * More precautions for cases where other routines call sbrk, courtesy of Wolfram Gloger (Gloger@lrz.uni-muenchen.de). * Added macros etc., allowing use in linux libc from H.J. Lu (hjl@gnu.ai.mit.edu) * Inverted this history list V2.6.1 Sat Dec 2 14:10:57 1995 Doug Lea (dl at gee) * Re-tuned and fixed to behave more nicely with V2.6.0 changes. * Removed all preallocation code since under current scheme the work required to undo bad preallocations exceeds the work saved in good cases for most test programs. * No longer use return list or unconsolidated bins since no scheme using them consistently outperforms those that don't given above changes. * Use best fit for very large chunks to prevent some worst-cases. * Added some support for debugging V2.6.0 Sat Nov 4 07:05:23 1995 Doug Lea (dl at gee) * Removed footers when chunks are in use. Thanks to Paul Wilson (wilson@cs.texas.edu) for the suggestion. V2.5.4 Wed Nov 1 07:54:51 1995 Doug Lea (dl at gee) * Added malloc_trim, with help from Wolfram Gloger (wmglo@Dent.MED.Uni-Muenchen.DE). V2.5.3 Tue Apr 26 10:16:01 1994 Doug Lea (dl at g) V2.5.2 Tue Apr 5 16:20:40 1994 Doug Lea (dl at g) * realloc: try to expand in both directions * malloc: swap order of clean-bin strategy; * realloc: only conditionally expand backwards * Try not to scavenge used bins * Use bin counts as a guide to preallocation * Occasionally bin return list chunks in first scan * Add a few optimizations from colin@nyx10.cs.du.edu V2.5.1 Sat Aug 14 15:40:43 1993 Doug Lea (dl at g) * faster bin computation & slightly different binning * merged all consolidations to one part of malloc proper (eliminating old malloc_find_space & malloc_clean_bin) * Scan 2 returns chunks (not just 1) * Propagate failure in realloc if malloc returns 0 * Add stuff to allow compilation on non-ANSI compilers from kpv@research.att.com V2.5 Sat Aug 7 07:41:59 1993 Doug Lea (dl at g.oswego.edu) * removed potential for odd address access in prev_chunk * removed dependency on getpagesize.h * misc cosmetics and a bit more internal documentation * anticosmetics: mangled names in macros to evade debugger strangeness * tested on sparc, hp-700, dec-mips, rs6000 with gcc & native cc (hp, dec only) allowing Detlefs & Zorn comparison study (in SIGPLAN Notices.) Trial version Fri Aug 28 13:14:29 1992 Doug Lea (dl at g.oswego.edu) * Based loosely on libg++-1.2X malloc. (It retains some of the overall structure of old version, but most details differ.) */ ������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/hash_fct.c���������������������������������������������������������������0000644�0001750�0001750�00000033361�13021324543�015540� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : hash_fct.c * * Descr.: hash function * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /* * These hash functions are mainly based on MurmurHash3. * * MurmurHash3 was written by Austin Appleby, and is placed in the public * domain. The author hereby disclaims copyright to this source code. * * The original code can be found here (see function MurmurHash3_x86_32) * http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp * * However, the original code does not address (efficiently) several issues: * data alignment * endianess * need for homegeneous hash (independently of the plateform 32/64) */ #include <stdlib.h> #include <stdint.h> #include <string.h> #include <math.h> #include <sys/types.h> /* some systems need this */ #if 1 #include "engine_pl.h" #else /* to test appart from gprolog (only need HAVE_xxx macros defined by autoconf) */ #include "gp_config.h" #endif #include "hash_fct.h" #ifdef HAVE_ENDIAN_H #include <endian.h> #endif #ifdef HAVE_SYS_ENDIAN_H #include <sys/endian.h> #endif #ifdef HAVE_BYTESWAP_H #include <byteswap.h> #endif #ifdef HAVE_FLOAT_H #include <float.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ #define HASH_FCT_INITIAL_SEED 1688943522 /* any number is OK */ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #if defined(_MSC_VER) #define FORCE_INLINE __forceinline #define ROTL32(x, y) _rotl(x, y) #define ROTL64(x, y) _rotl64(x, y) #else /* !defined(_MSC_VER) */ #if defined(__GNUC__) #define FORCE_INLINE __inline __attribute__ ((always_inline)) #else #define FORCE_INLINE #endif static FORCE_INLINE uint32_t ROTL32(uint32_t x, int8_t r) { return (x << r) | (x >> (32 - r)); } static FORCE_INLINE uint64_t ROTL64(uint64_t x, int8_t r) { return (x << r) | (x >> (64 - r)); } #endif /* !defined(_MSC_VER) */ /* * Hash_Initialize (mainly set initial seed for MurmurHash3) */ static FORCE_INLINE uint32_t Hash_Initialize(void) { return HASH_FCT_INITIAL_SEED; } /* * Hash_Block (hash a 32 bits block) * this is the body the the main MurmurHash3 loop */ static FORCE_INLINE uint32_t Hash_Block(uint32_t k1, uint32_t h1) /* h1 is the current hash */ { const uint32_t c1 = 0xcc9e2d51; const uint32_t c2 = 0x1b873593; k1 *= c1; k1 = ROTL32(k1, 15); k1 *= c2; h1 ^= k1; h1 = ROTL32(h1, 13); h1 = h1 * 5 + 0xe6546b64; return h1; } /* * Hash_Finalize * (corresponds to fmix of MurmurHash3 + the h ^= len done outside) * * fmix - force all bits of a hash block to avalanche */ static FORCE_INLINE uint32_t Hash_Finalize(uint32_t h, int len) { h ^= len; h ^= h >> 16; h *= 0x85ebca6b; h ^= h >> 13; h *= 0xc2b2ae35; h ^= h >> 16; return h; } /* * Hash_Buffer (this is MurmurHash3_x86_32) * Hash_Buffer_Aligned * Hash_Buffer_Unaligned */ #define HASH_BUFFER_FCT Hash_Buffer_Aligned #include "hash_fct1.c" #undef HASH_BUFFER_FCT #define HASH_BUFFER_FCT Hash_Buffer_Unaligned #define USE_32BITS_ALIGNMENT #include "hash_fct1.c" uint32_t Hash_Buffer(const void *key, int len, uint32_t seed) { if (((uintptr_t) key & 3) == 0) /* is it aligned on blocks (uint32_t) ? */ return Hash_Buffer_Aligned(key, len, seed); return Hash_Buffer_Unaligned(key, len, seed); } /*-------------------------------------------------------------------------* * The above functions (based on MurmurHash3) are not directly used by the * * Prolog engine. Instead they provide (none have to handle endianess): * * * * Hash_Initialize * * Hash_Finalize * * Hash_Buffer (which in turn needs Hash_Buffer_Aligned / _Unaligned) * * Hash_Block * * * * This decomposition is provided for incremental hashing. * * * * To change the hashing method (e.g. xxhash, FNV1A_Yorikke,...) it is * * only necessary to provide an implementation for the above functions. * * * * These functions are used to implement the API used by the Prolog engine * * composed of the next functions. They could be in another file (but here * * inlining can occur). * * They handle buffers (strings) and numbers separately (for endianness). * * They provide incremental hashing. * *-------------------------------------------------------------------------*/ #if !HAVE_DECL_BSWAP_32 uint32_t bswap_32(uint32_t x) { x = ((x & 0xff) << 24) | ((x & 0xff00) << 8) | ((x >> 8) & 0xff00) | (x >> 24); return x; } #endif /* !HAVE_DECL_BSWAP_32 */ #if !HAVE_DECL_HTOLE32 #ifdef htole32 /* should be useless but in case of... */ #undef htole32 #endif static uint32_t htole32(uint32_t x) { #ifdef WORDS_BIGENDIAN return bswap_32(x); #else return x; #endif } #endif /* !HAVE_DECL_HTOLE32 */ /*-------------------------------------------------------------------------* * PL_HASH_BUFFER * * * * This is the same as: * * * * Pl_Hash_Incr_Init(hi); * * Pl_Hash_Incr_Init(hi, data, len); * * Pl_Hash_Incr_Term(hi); * *-------------------------------------------------------------------------*/ uint32_t Pl_Hash_Buffer(const void *data, int len) { uint32_t hash = Hash_Initialize(); hash = Hash_Buffer(data, len, hash); hash = Hash_Finalize(hash, len); return hash; } /*-------------------------------------------------------------------------* * PL_HASH_INCR_INIT * * * *-------------------------------------------------------------------------*/ void Pl_Hash_Incr_Init(HashIncrInfo *hi) { hi->len = 0; hi->hash = Hash_Initialize(); } /*-------------------------------------------------------------------------* * PL_HASH_INCR_BUFFER * * * *-------------------------------------------------------------------------*/ void Pl_Hash_Incr_Buffer(HashIncrInfo *hi, const void *data, int len) { hi->len += len; hi->hash = Hash_Buffer(data, len, hi->hash); } /*-------------------------------------------------------------------------* * PL_HASH_INCR_INT32 * * * *-------------------------------------------------------------------------*/ void Pl_Hash_Incr_Int32(HashIncrInfo *hi, uint32_t x) { hi->len += 4; hi->hash = Hash_Block(htole32(x), hi->hash); } /*-------------------------------------------------------------------------* * PL_HASH_INCR_INT64 * * * *-------------------------------------------------------------------------*/ void Pl_Hash_Incr_Int64(HashIncrInfo *hi, uint64_t x) { Pl_Hash_Incr_Int32(hi, (uint32_t) x); Pl_Hash_Incr_Int32(hi, x >> 32); } /*-------------------------------------------------------------------------* * PL_HASH_INCR_DOUBLE * * * * NB: hashing float numbers is definitively not a good idea. * *-------------------------------------------------------------------------*/ void Pl_Hash_Incr_Double(HashIncrInfo *hi, double x) #ifndef DBL_MAX_EXP #define DBL_MAX_EXP 1024 #endif #ifndef DBL_MANT_DIG #define DBL_MANT_DIG 53 #endif #ifndef UINT64_MAX #define UINT64_MAX ((uint64_t) -1) #endif /* * IEEE 754: x is represented as: man * 2^exp with 0.5 <= |man| < 1 * A double is encoded on 64 bits as follows: * man is on 53 bits (52 encoded since 1 bit is implicitely set to 1) * exp is on 11 bits (signed) (can encode in radix 10 -307..308) * +1 bit for the overall sign * A double can represent 1.0, * next value > 1 is 1.0000000000000002, next is 1.0000000000000004 */ /* multiplier to use maximum bits of mantissa (according to target type) * To be exact should be (UINT64_MAX + 1.0) (something like 1<<64) * Does not work for MSVC: max is 1 << 63 because it exceeds signed int 64 bits */ #if 0 #define DEBUG #endif #define MULT ((uint64_t) 1 << 63) /*#define MULT ((uint64_t) 1 << 32)*/ /* test with less decimals */ { int exp; uint64_t man64; uint64_t rest; #ifdef DEBUG printf("dbl: %.15g\n", x); #endif x = frexp(x, &exp); /* x is now the mantissa */ #ifdef DEBUG printf("man: %.15f\n", x); printf("exp: %d\n", exp); #endif /* Mantissa between 0 and 1 (other possibility: x = (2 * fabs(x) - 1) slower) */ if (x < 0.0) x = -(x + 0.5); /* Mantissa on maximum bits for the target type (here 64 bits) */ x *= MULT; #ifdef DEBUG printf("man scaled : %.2f\n", x); #endif /* NB: signed cast (int64_t) is much faster than unsigned (uint64_t) * Anyway: here we only want bits * Other possibility: use lrint() math function but is missing under MSVC */ man64 = (int64_t) x; #ifdef DEBUG printf("man integer: %" FMT64_d "\n", man64); #endif #if 0 /* hash both mantissa and exponent */ Pl_Hash_Incr_Int64(hi, man64); Pl_Hash_Incr_Int32(hi, exp); #else /* This one is more suited to take less decimals into account (decrease MULT) */ /* missing */ #if 0 /* only usefull if mantissa is converted to a smaller type (e.g.int32), else = 0 */ rest = (x - (double) man64) * MULT; #else rest = 0; #endif #ifdef DEBUG printf("rest: %" FMT64_x "\n", rest); printf("div: %" FMT64_d " = 0x%" FMT64_x "\n", (MULT / DBL_MAX_EXP), (MULT / DBL_MAX_EXP)); #endif /* take into account exp */ man64 = man64 + rest + (MULT / DBL_MAX_EXP) * exp; #ifdef DEBUG printf("final value: %" FMT64_d "\n", man64); #endif Pl_Hash_Incr_Int64(hi, man64); #endif } /*-------------------------------------------------------------------------* * PL_HASH_INCR_TERM * * * *-------------------------------------------------------------------------*/ uint32_t Pl_Hash_Incr_Term(HashIncrInfo *hi) { hi->hash = Hash_Finalize(hi->hash, hi->len); return hi->hash; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/arch_dep.h���������������������������������������������������������������0000644�0001750�0001750�00000027047�13021324543�015537� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : configuration * * File : arch_dep.h * * Descr.: architecture dependent features - Header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _ARCH_DEP_H #define _ARCH_DEP_H #define CPP_STR1(s) #s #define CPP_STR(s) CPP_STR1(s) #define CPP_CAT1(x, y) x ## y #define CPP_CAT(x, y) CPP_CAT1(x, y) /* C compiler version (for more general handling see http://sourceforge.net/projects/predef) */ #if defined(__clang__) /* put before because also defines __GNUC__ */ #define CC_MAJOR __clang_major__ #define CC_MINOR __clang_minor__ #define CC_PATCHLEVEL __clang_patchlevel__ #elif defined(__GNUC__) #define CC_MAJOR __GNUC__ #define CC_MINOR __GNUC_MINOR__ #define CC_PATCHLEVEL __GNUC_PATCHLEVEL__ #elif defined(_MSC_FULL_VER) #define CC_MAJOR (_MSC_FULL_VER / 1000000) #define CC_MINOR (_MSC_FULL_VER % 1000000 / 10000) #define CC_PATCHLEVEL (_MSC_FULL_VER % 10000) #elif defined(_MSC_VER) #define CC_MAJOR (_MSC_VER / 100) #define CC_MINOR (_MSC_VER % 100) #define CC_PATCHLEVEL 0 #else #define CC_MAJOR 0 #define CC_MINOR 0 #define CC_PATCHLEVEL 0 #endif /* Compile date */ #if defined(__DATE__) && defined(__TIME__) #define COMPILED_AT __DATE__ ", " __TIME__ #else #define COMPILED_AT "unknown date" #endif #if defined(_WIN32) && !defined(__CYGWIN__) /* There are 2 kinds of MSVC warning C4996 one wants to remove: * 1) XXX was declared deprecated ... This function or variable may be unsafe * solution: #define _CRT_SECURE_NO_DEPRECATE 1 * 2) The POSIX name for this item is deprecated * solution: #define _CRT_NONSTDC_NO_DEPRECATE 1 * However, these defines only work if they are before any #include <...> * So: pass to cl: -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE * or deactivate the warning with the following pragma. We do both ! */ #ifdef _MSC_VER #pragma warning(disable : 4996) #endif #define MAXPATHLEN 1024 #define SIGQUIT SIGTERM #define fdopen _fdopen #define dup _dup #define dup2 _dup2 #define getcwd _getcwd #define chdir _chdir #define close _close #define pclose _pclose #define popen _popen #define pclose _pclose #define getpid _getpid #define tempnam _tempnam #define unlink _unlink #define tzset _tzset #define access _access #ifdef _MSC_VER #define strcasecmp stricmp #define strncasecmp strnicmp #define spawnvp _spawnvp #endif #ifndef F_OK #define F_OK 00 #define W_OK 02 #define R_OK 04 #define X_OK F_OK #endif #ifndef S_ISDIR #define S_ISDIR(m) (((m)&_S_IFMT) == _S_IFDIR) #define S_ISCHR(m) (((m)&_S_IFMT) == _S_IFCHR) #define S_ISFIFO(m) (((m)&_S_IFMT) == _S_IFIFO) #define S_ISREG(m) (((m)&_S_IFMT) == _S_IFREG) #endif #ifndef S_IRUSR #define S_IRUSR _S_IREAD #define S_IWUSR _S_IWRITE #define S_IXUSR _S_IEXEC #endif #define DIR_SEP_S "\\" #define DIR_SEP_C '\\' #define DIR_SEP_C_ALT '/' #elif defined(__CYGWIN__) #define DIR_SEP_S "/" #define DIR_SEP_C '/' #define DIR_SEP_C_ALT '\\' #else /* Unix */ #define DIR_SEP_S "/" #define DIR_SEP_C '/' #define DIR_SEP_C_ALT '/' #endif #define Is_Dir_Sep(c) ((c) == DIR_SEP_C || (c) == DIR_SEP_C_ALT) #define Find_Last_Dir_Sep(_p, _path) \ do { \ char *_ptr; \ \ for((_p) = NULL, _ptr = (_path); *_ptr; _ptr++) \ if (Is_Dir_Sep(*_ptr)) \ (_p) = _ptr; \ } while(0) #define Has_Drive_Specif(str) \ (((*(str) >= 'a' && *(str) <= 'z') || (*(str) >= 'A' && *(str) <= 'Z')) && (str)[1] == ':') #if defined(M_ix86_cygwin) || defined(M_ix86_sco) #define Set_Line_Buf(s) setvbuf(s, NULL, _IOLBF, 0) #elif defined(_WIN32) #define Set_Line_Buf(s) setbuf(s, NULL) #else #define Set_Line_Buf(s) setlinebuf(s) #endif #ifndef NO_USE_GUI_CONSOLE #define W32_GUI_CONSOLE #endif #ifdef M_sparc_sunos #define __USE_FIXED_PROTOTYPES__ #endif #if defined(M_ix86_sco) #ifndef MAXPATHLEN #define MAXPATHLEN 1024 #endif #endif #if !defined(_WIN32) && !defined(__unix__) #define __unix__ #endif #ifndef HAVE_FGETC #define fgetc getc #endif #ifndef HAVE_SIGSETJMP #define sigjmp_buf jmp_buf #define sigsetjmp(jb, x) setjmp(jb) #define siglongjmp longjmp #endif #if defined(_WIN64) && !defined(_MSC_VER) /* Mingw64-gcc implements setjmp with msvcrt's _setjmp. This _setjmp * has an additional (hidden) argument. If it is NULL, longjmp will NOT do * stack unwinding (needed for SEH). By default the the second argument is * NOT null (it is $rsp), then longjmp will try a stack unwinding which will * crash gprolog. * NB: _setjmp stores this argument in the jmp_buf (in the first bytes) * Mingw-gcc v < 4.6 fixed this at longjmp (before calling msvcrt's _longjmp) * (see file: lib64_libmingwex_a-mingw_getsp.o in library libmingwex.a) * * 0000000000000006 <longjmp>: # x86_64 ABI: jmp_buf is in $rcx * 6: 31 c0 xor %eax,%eax * 8: 89 01 mov %eax,(%rcx) # set 0 in the first word of jmp_buf * a: 48 8d 05 00 00 00 00 lea 0x0(%rip),%rax # this will call dll msvcrt's longjmp * 11: ff 20 jmpq *(%rax) * * while in >= 4.6: (no more fixes) * * 0000000000000006 <longjmp>: * 6: 48 8d 05 00 00 00 00 lea 0x0(%rip),%rax # this will call dll msvcrt's longjmp * d: ff 20 jmpq *(%rax) * f: 90 nop * */ #ifdef setjmp #undef setjmp #endif #define setjmp(buf) _setjmp(buf, NULL) #endif /* Fast call macros */ #if defined(M_ix86) /* FC_MAX_ARGS_IN_REGS can be decreased (0, 1, 2) - but the inline_asm_data * is compiled with 3, if changed, change inlined code in mapper */ #define COULD_COMPILE_FOR_FC #ifdef __GNUC__ #define FC_MAX_ARGS_IN_REGS 3 #define FC_SET_OF_REGISTERS { "%eax", "%edx", "%ecx" }; #define FC_ATTRIB __attribute__((regparm(FC_MAX_ARGS_IN_REGS))) #elif 0 /* under MSVC++ we can use __fastcall convention (#elif 1 if wanted) */ /* see file ix86_any.c to see why it is not selected by default */ #define FC_MAX_ARGS_IN_REGS 2 #define FC_SET_OF_REGISTERS { "%ecx", "%edx" }; #define FC_ATTRIB __fastcall #else #define FC_MAX_ARGS_IN_REGS 0 #define FC_SET_OF_REGISTERS { NULL }; #define FC_ATTRIB #endif #endif #if !defined(NO_USE_FAST_CALL) && defined(FC_ATTRIB) #define FC_USED_TO_COMPILE_CORE #ifndef FC /* to compile Ma2Asm/check.c without FC */ #define FC FC_ATTRIB #endif #else #define FC #endif /* Win32 SEH macros */ #if defined(_WIN32) && !defined(_WIN64) || defined(__CYGWIN__) #define USE_SEH #endif #if defined(USE_SEH) /* from MSVC++ windows.h + renaming */ typedef enum { ExceptContinueExecution, ExceptContinueSearch, ExceptNestedException, ExceptCollidedUnwind } EXCEPT_DISPOSITION; typedef struct _excp_lst { struct _excp_lst *chain; EXCEPT_DISPOSITION (*handler)(); } excp_lst; #ifdef __GNUC__ # define SEH_PUSH(new_handler) \ { \ excp_lst e; \ EXCEPT_DISPOSITION new_handler(); \ e.handler = new_handler; \ asm("movl %%fs:0,%0" : "=r" (e.chain)); \ asm("movl %0,%%fs:0" : : "r" (&e)); # define SEH_POP \ asm("movl %0,%%fs:0" : : "r" (e.chain)); \ } #elif defined(_MSC_VER) # pragma warning(disable:4733) /* we know what we are doing with SEH */ # define SEH_PUSH(new_handler) \ { \ excp_lst e; \ EXCEPT_DISPOSITION new_handler(); \ e.handler = new_handler; \ __asm push eax \ __asm mov eax,dword ptr fs:[0] \ __asm mov dword ptr [e.chain],eax \ __asm lea eax,[e] \ __asm mov dword ptr fs:[0],eax \ __asm pop eax # define SEH_POP \ __asm push eax \ __asm mov eax,dword ptr [e.chain] \ __asm mov dword ptr fs:[0],eax \ __asm pop eax \ } #elif defined(__LCC__) /* below in movl %eax,%e and movel %e,%eax %e should be %e.chain the lcc asm does not support it. Here %e works since chain is the 1st field */ # define SEH_PUSH(new_handler) \ { \ excp_lst e; \ EXCEPT_DISPOSITION new_handler(); \ e.handler = new_handler; \ _asm("pushl %eax"); \ _asm("movl %fs:0,%eax"); \ _asm("movl %eax,%e"); \ _asm("leal %e,%eax"); \ _asm("movl %eax,%fs:0"); \ _asm("popl %eax"); # define SEH_POP \ _asm("pushl %eax"); \ _asm("movl %e,%eax"); \ _asm("movl %eax,%fs:0"); \ _asm("popl %eax"); \ } #else # error macros SEH_PUSH/POP undefined for this compiler #endif #endif /* defined(USE_SEH) */ #endif /* !_ARCH_DEP_H */ �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/gprolog_cst.h������������������������������������������������������������0000644�0001750�0001750�00000001223�13020764326�016306� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� #define __GNU_PROLOG__ 1 #define __GPROLOG__ 1 #define __GPROLOG_MINOR__ 4 #define __GPROLOG_PATCHLEVEL__ 5 #define __GPROLOG_VERSION__ 10405 #define PROLOG_DIALECT "gprolog" #define PROLOG_NAME "GNU Prolog" #define PROLOG_VERSION "1.4.5" #define PROLOG_DATE "Dec 4 2016" #define PROLOG_COPYRIGHT "Copyright (C) 1999-2015 Daniel Diaz" #define PL_MIN_INTEGER -1152921504606846976 #define PL_MAX_INTEGER 1152921504606846975 #define PL_REF 0 #define PL_LST 1 #define PL_STC 2 #define PL_ATM 3 #define PL_FLT 4 #define PL_FDV 5 #define PL_INT 7 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/wam_archi.def������������������������������������������������������������0000644�0001750�0001750�00000012120�13021324543�016215� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : wam_archi.def (gives rise to wam_archi.h) * * Descr.: Wam architecture definition - description file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "pl_long.h" /*---------------------------------* * Register Descriptions * *---------------------------------*/ typedef intptr_t WamWord; /* a WamWord can store a ptr (32/64 bits) */ typedef void (*CodePtr) (); /* a code pointer is a ptr to fct */ typedef CodePtr WamCont; /* a continuation is a code pointer */ #ifndef ONLY_TAG_PART #define X(x) (pl_reg_bank[x]) #define A(a) (pl_reg_bank[a]) typedef WamWord *WamWordP; @begin regs @filler NB_OF_X_REGS @reg 4 WamCont CP /* Continuation pointer */ @reg 4 WamWordP E /* Last environment pointer */ @reg 2 WamWordP B /* Last choice point pointer */ @reg 3 WamWordP H /* Top of the heap */ @reg 3 WamWordP HB1 /* copy of HB(B) */ @reg 1 WamWordP TR /* Top of the trail */ @reg 5 WamWordP S /* Unification pointer */ @reg 9 WamWord STAMP /* Choice point stamp (for FD) */ @reg 4 WamWordP CS /* Top of the constraint stack */ @reg 9 WamWord BCI /* Byte-code info */ @reg 9 WamWordP LSSA /* Local stack start address */ @end regs #endif /*---------------------------------* * Tag Descriptions * *---------------------------------*/ @begin tags @tag REF address 0 /* Reference */ @tag LST address 1 /* List */ @tag STC address 2 /* Structure */ @tag ATM short_uns 3 /* Atom */ @tag FLT address 4 /* Float */ @tag FDV address 5 /* Finite Domain Variable */ @tag INT long_int 7 /* Integer */ @end tags /*---------------------------------* * Stack Descriptions * *---------------------------------*/ #ifndef ONLY_TAG_PART #define KBytes_To_Wam_Words(kb) ((1024 * kb + sizeof(WamWord) - 1) / sizeof(WamWord)) #define Wam_Words_To_KBytes(ww) (ww * sizeof(WamWord) / 1024) #define Local_Top ((B >= E) ? B : E) @begin stacks @stack trail "Trail Stack (undo)" 16384 TR /* Trail stack */ @stack cstr "Cstr Stack (constraints)" 16384 CS /* Constraint stack */ @stack global "Global Stack (heap)" 32768 H /* Global stack */ @stack local "Local Stack (control)" 16384 Local_Top /* Local stack (after global) */ @end stacks #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/mem_alloc.c��������������������������������������������������������������0000644�0001750�0001750�00000006424�13021324543�015711� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : mem_alloc.c * * Descr.: customized memory allocator * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "gp_config.h" /*-------------------------------------------------------------------------* * If needed for some machine: redefine here malloc/calloc/realloc/free by * * inserting an appropriate file. * *-------------------------------------------------------------------------*/ /* this is no longer used for linux, see mallopt initial call in machine.c */ #if 0 && defined(M_linux) #ifdef HAVE_MMAP #undef HAVE_MMAP #endif #define HAVE_MMAP 0 /* do not use mmap for big blocks */ #include "dl_malloc.c" #endif ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/machine.c����������������������������������������������������������������0000644�0001750�0001750�00000062437�13021324543�015373� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : machine.c * * Descr.: machine dependent features * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <signal.h> #include <errno.h> #include <fcntl.h> #include <ctype.h> #include <string.h> #include <time.h> #include <sys/types.h> #include <sys/stat.h> #include "gp_config.h" /* ensure __unix__ defined if not Win32 */ #if defined(_WIN32) || defined(__CYGWIN__) #include <windows.h> /* warning: windows.h defines _WIN32 */ #endif #if defined(__unix__) || defined(__CYGWIN__) #include <pwd.h> #include <unistd.h> #include <sys/param.h> #include <sys/time.h> #include <sys/times.h> #include <sys/resource.h> #ifdef __CYGWIN__ #include <sys/cygwin.h> #endif #else /* _WIN32 */ #include <process.h> #include <direct.h> #endif #include "engine_pl.h" /* before netdb.h which declares a function */ /* gcc cannot define a global reg var after a fct */ #ifdef HAVE_MALLOC_H #include <malloc.h> #endif #ifndef NO_USE_SOCKETS # if defined(__unix__) || defined(__CYGWIN__) #include <netdb.h> #include <netinet/in.h> #include <arpa/inet.h> #include <sys/socket.h> # endif #define INET_MANAGEMENT #endif #if 0 #define DEBUG #endif /*---------------------------------* * Constants * *---------------------------------*/ #define M_MAGIC1 0x12345678 #define M_MAGIC2 0xdeadbeef #define UNKNOWN_SYS_ERRNO "Unknown error (%d)" /* Error Messages */ #define ERR_STACKS_ALLOCATION "Memory allocation fault" #define ERR_CANNOT_OPEN_DEV0 "Cannot open /dev/zero : %s" #define ERR_CANNOT_UNMAP "unmap failed : %s" #define ERR_CANNOT_FREE "VirtualFree failed : %" PL_FMT_u #define ERR_CANNOT_PROTECT "VirtualProtect failed : %" PL_FMT_u #define ERR_CANNOT_EXEC_GETCWD "cannot execute getcwd" #define ERR_STACK_OVERFLOW_ENV "%s stack overflow (size: %d Kb, reached: %d Kb, environment variable used: %s)" #define ERR_STACK_OVERFLOW_NO_ENV "%s stack overflow (size: %d Kb, reached: %d Kb - fixed size)" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static PlLong start_user_time = 0; static PlLong start_system_time = 0; static PlLong start_real_time = 0; static int cur_seed = 1; /*---------------------------------* * Function Prototypes * *---------------------------------*/ #ifdef INET_MANAGEMENT static char *Host_Name_From_Alias(struct hostent *host_entry); #endif #define Round_Up(x, y) (((x) + (y) - 1) / (y) * (y)) #define Round_Down(x, y) ((x) / (y) * (y)) /*-------------------------------------------------------------------------* * PL_INIT_MACHINE * * * *-------------------------------------------------------------------------*/ void Pl_Init_Machine(void) { tzset(); start_user_time = Pl_M_User_Time(); start_system_time = Pl_M_System_Time(); start_real_time = Pl_M_Real_Time(); #if defined(HAVE_MALLOPT) && defined(M_MMAP_MAX) mallopt(M_MMAP_MAX, 0); #endif Pl_Init_Machine1(); } /*-------------------------------------------------------------------------* * PL_M_SYS_ERR_STRING * * * *-------------------------------------------------------------------------*/ char * Pl_M_Sys_Err_String(int ret_val) { #ifdef M_sparc_sunos extern char *sys_errlist[]; extern int sys_nerr; #endif char *str; static char buff[64]; #if defined(_WIN32) || defined(__CYGWIN__) if (ret_val == M_ERROR_WIN32) { int status = GetLastError(); if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, NULL, status, 0, buff, sizeof(buff), NULL) == 0) sprintf(buff, "Windows " UNKNOWN_SYS_ERRNO, status); else { /* windows adds a ".\r\n" at end - remove it */ char *p = buff + strlen(buff); while (--p > buff && (isspace(*p) || *p == '.')) { } p[1] = '\0'; } return buff; } #endif #if defined(M_sparc_sunos) str = (errno >= 0 && errno < sys_nerr) ? sys_errlist[errno] : NULL; #else str = strerror(errno); #endif if (str) return str; sprintf(buff, UNKNOWN_SYS_ERRNO, errno); return buff; } /*-------------------------------------------------------------------------*/ /* M_USER_TIME */ /* */ /* returns the user time used since the start of the process (in ms). */ /*-------------------------------------------------------------------------*/ PlLong Pl_M_User_Time(void) { PlLong user_time; #if defined(__unix__) && !defined(__CYGWIN__) struct rusage rsr_usage; getrusage(RUSAGE_SELF, &rsr_usage); user_time = (rsr_usage.ru_utime.tv_sec * 1000) + (rsr_usage.ru_utime.tv_usec / 1000); #elif defined(_WIN32) || defined(__CYGWIN__) FILETIME creat_t, exit_t, kernel_t, user_t; /* Success on Windows NT */ if (GetProcessTimes(GetCurrentProcess(), &creat_t, &exit_t, &kernel_t, &user_t)) user_time = (PlLong) (((__int64) user_t.dwHighDateTime << 32) + (__int64) user_t.dwLowDateTime) / 10000; else /* not implemented on Windows 95/98 */ user_time = (PlLong) ((double) clock() * 1000 / CLOCKS_PER_SEC); #else Pl_Fatal_Error("user time not available"); return 0; #endif return user_time - start_user_time; } /*-------------------------------------------------------------------------* * PL_M_SYSTEM_TIME * * * * returns the system time used since the start of the process (in ms). * *-------------------------------------------------------------------------*/ PlLong Pl_M_System_Time(void) { PlLong system_time; #if defined(__unix__) && !defined(__CYGWIN__) struct rusage rsr_usage; getrusage(RUSAGE_SELF, &rsr_usage); system_time = (rsr_usage.ru_stime.tv_sec * 1000) + (rsr_usage.ru_stime.tv_usec / 1000); #elif defined(_WIN32) || defined(__CYGWIN__) FILETIME creat_t, exit_t, kernel_t, user_t; /* Success on Windows NT */ if (GetProcessTimes(GetCurrentProcess(), &creat_t, &exit_t, &kernel_t, &user_t)) system_time = (PlLong) (((__int64) kernel_t.dwHighDateTime << 32) + (__int64) kernel_t.dwLowDateTime) / 10000; else /* not implemented on Windows 95/98 */ system_time = 0; #else Pl_Fatal_Error("system time not available"); return 0; #endif return system_time - start_system_time; } /*-------------------------------------------------------------------------* * PL_M_REAL_TIME * * * * returns the real time used since the start of the process (in ms). * *-------------------------------------------------------------------------*/ PlLong Pl_M_Real_Time(void) { PlLong real_time; #if defined(__unix__) && !defined(__CYGWIN__) struct timeval tv; gettimeofday(&tv, NULL); real_time = (tv.tv_sec * 1000) + (tv.tv_usec / 1000); #elif defined(_WIN32) || defined(__CYGWIN__) real_time = (PlLong) ((double) clock() * 1000 / CLOCKS_PER_SEC); #else Pl_Fatal_Error("real time not available"); return 0; #endif return real_time - start_real_time; } #ifndef RAND_MAX #define RAND_MAX (((unsigned) -1) >> 1) #endif /*-------------------------------------------------------------------------* * PL_M_RANDOMIZE * * * *-------------------------------------------------------------------------*/ void Pl_M_Randomize(void) { static int count = 0; #if defined(_WIN32) || defined(__CYGWIN__) int seed = GetTickCount(); #else struct timeval tv; int seed; gettimeofday(&tv, NULL); seed = (tv.tv_sec * 1000) + (tv.tv_usec / 1000); #endif count = (count + rand()) % 0xFFFF; seed = seed ^ (getpid() << (seed & 0xFF)); seed *= count; seed = seed & 0xFFFFFF; Pl_M_Set_Seed(seed); } /*-------------------------------------------------------------------------* * PL_M_SET_SEED * * * *-------------------------------------------------------------------------*/ void Pl_M_Set_Seed(int n) { cur_seed = n; srand(cur_seed); } /*-------------------------------------------------------------------------* * PL_M_GET_SEED * * * *-------------------------------------------------------------------------*/ int Pl_M_Get_Seed(void) { return cur_seed; } /*-------------------------------------------------------------------------* * PL_M_RANDOM_INTEGER * * * * return an integer x s.t. 0 <= x < n * *-------------------------------------------------------------------------*/ int Pl_M_Random_Integer(int n) { return (int) ((double) n * rand() / (RAND_MAX + 1.0)); } /*-------------------------------------------------------------------------* * PL_M_RANDOM_FLOAT * * * * return a double x s.t. 0 <= x < n * *-------------------------------------------------------------------------*/ double Pl_M_Random_Float(double n) { return n * rand() / (RAND_MAX + 1.0); } /*-------------------------------------------------------------------------* * PL_M_HOST_NAME_FROM_NAME * * * * if host_name == NULL use current host name. * *-------------------------------------------------------------------------*/ char * Pl_M_Host_Name_From_Name(char *host_name) { static char buff[4096]; #ifdef INET_MANAGEMENT struct hostent *host_entry; #endif if (host_name == NULL) { PlLong length = sizeof(buff); host_name = buff; #if defined(_WIN32) && !defined(__CYGWIN__) && defined(NO_USE_SOCKETS) if (GetComputerName(buff, &length) == 0) #else if (gethostname(buff, length)) #endif { strcpy(buff, "unknown host name"); goto finish; } } if (strchr(host_name, '.') != NULL) /* qualified name */ goto finish; #ifdef INET_MANAGEMENT host_entry = gethostbyname(host_name); /* use name server */ if (host_entry == NULL) goto finish; host_name = Host_Name_From_Alias(host_entry); #endif finish: return host_name; } /*-------------------------------------------------------------------------* * PL_M_HOST_NAME_FROM_ADR * * * *-------------------------------------------------------------------------*/ char * Pl_M_Host_Name_From_Adr(char *host_address) { #ifdef INET_MANAGEMENT struct hostent *host_entry; struct in_addr iadr; #if defined(M_sparc_sunos) || defined(M_sparc_solaris) || \ defined(M_ix86_cygwin) || defined(M_ix86_solaris) || \ defined(_WIN32) if ((iadr.s_addr = inet_addr(host_address)) == -1) #else if (inet_aton(host_address, &iadr) == 0) #endif return FALSE; host_entry = gethostbyaddr((char *) &iadr, sizeof(iadr), AF_INET); if (host_entry == NULL) return NULL; return Host_Name_From_Alias(host_entry); #else return NULL; #endif } #ifdef INET_MANAGEMENT /*-------------------------------------------------------------------------* * HOST_NAME_FROM_ALIAS * * * *-------------------------------------------------------------------------*/ static char * Host_Name_From_Alias(struct hostent *host_entry) { char *name; char **alias; char *p; name = (char *) host_entry->h_name; alias = host_entry->h_aliases; while ((p = strchr(name, '.')) == NULL && *alias) name = *alias++; if (p) return name; return (char *) host_entry->h_name; } #endif /*-------------------------------------------------------------------------* * PL_M_SET_WORKING_DIR * * * * must preserve errno if fails (used in os_interf_c.c) * *-------------------------------------------------------------------------*/ Bool Pl_M_Set_Working_Dir(char *path) { char *new_path = Pl_M_Absolute_Path_Name(path); return (new_path != NULL && chdir(new_path) == 0); } /*-------------------------------------------------------------------------* * PL_M_GET_WORKING_DIR * * * *-------------------------------------------------------------------------*/ char * Pl_M_Get_Working_Dir(void) { static char cur_work_dir[MAXPATHLEN]; if (getcwd(cur_work_dir, sizeof(cur_work_dir) - 1) == NULL) strcpy(cur_work_dir, "."); return cur_work_dir; } /*-------------------------------------------------------------------------* * PL_M_ABSOLUTE_PATH_NAME * * * * returns an absolute file name. * *-------------------------------------------------------------------------*/ char * Pl_M_Absolute_Path_Name(char *src) { static char buff[2][MAXPATHLEN]; int res = 0; char *dst; char *p, *q; char c; dst = buff[res]; while ((*dst++ = *src)) /* expand $VARNAME and %VARNAME% (Win32) */ { c = *src++; if (c == '$' #if defined(_WIN32) || defined(__CYGWIN__) || c == '%' #endif ) { p = dst; while (isalnum(*src) || *src == '_') *dst++ = *src++; #if defined(_WIN32) || defined(__CYGWIN__) if (c == '%' && *src != '%') continue; #endif *dst = '\0'; q = getenv(p); if (q) { p--; strcpy(p, q); dst = p + strlen(p); #if defined(_WIN32) || defined(__CYGWIN__) if (c == '%') src++; #endif } #if defined(_WIN32) || defined(__CYGWIN__) else if (c == '%') *dst++ = *src++; #endif } } *dst = '\0'; if (buff[res][0] == '~') { if (Is_Dir_Sep(buff[res][1]) || buff[res][1] == '\0') /* ~/... cf $HOME */ { q = NULL;; if ((p = getenv("HOME")) == NULL) { #if defined(_WIN32) || defined(__CYGWIN__) if ((p = getenv("HOMEPATH")) == NULL) return NULL; q = getenv("HOMEDRIVE"); #else return NULL; #endif } if (q == NULL) q = ""; sprintf(buff[1 - res], "%s%s/%s", q, p, buff[res] + 1); res = 1 - res; } #if defined(__unix__) || defined(__CYGWIN__) else /* ~user/... read passwd */ { struct passwd *pw; p = buff[res] + 1; while (*p && !Is_Dir_Sep(*p)) p++; buff[res][0] = *p; *p = '\0'; if ((pw = getpwnam(buff[res] + 1)) == NULL) return NULL; *p = buff[res][0]; sprintf(buff[1 - res], "%s/%s", pw->pw_dir, p); res = 1 - res; } #endif } if (strcmp(buff[res], "user") == 0) /* prolog special file 'user' */ return buff[res]; #if defined(_WIN32) && !defined(__CYGWIN__) if (_fullpath(buff[1 - res], buff[res], MAXPATHLEN) == NULL) return NULL; res = 1 - res; for (dst = buff[res]; *dst; dst++) /* \ becomes / */ if (*dst == '\\') *dst = '/'; /* dst points the \0 */ #else /* __unix__ || __CYGWIN__ */ #if defined(__CYGWIN__) cygwin_conv_to_full_posix_path(buff[res], buff[1 - res]); res = 1 - res; #endif if (buff[res][0] != '/') /* add current directory */ { sprintf(buff[1 - res], "%s/%s", Pl_M_Get_Working_Dir(), buff[res]); res = 1 - res; } src = buff[res]; res = 1 - res; dst = buff[res]; while ((*dst++ = *src)) { if (*src++ != '/') continue; collapse: while (*src == '/') /* collapse /////... as / */ src++; if (*src != '.') continue; if (src[1] == '/' || src[1] == '\0') /* /./ removed */ { src++; goto collapse; } if (src[1] != '.' || (src[2] != '/' && src[2] != '\0')) continue; /* case /../ */ src += 2; p = dst - 2; while (p >= buff[res] && *p != '/') p--; if (p < buff[res]) return NULL; dst = p; } dst--; /* dst points the \0 */ #endif #if defined(_WIN32) && !defined(__CYGWIN__) #define MIN_PREFIX 3 /* win32 minimal path c:\ */ #else #define MIN_PREFIX 1 /* unix minimal path / */ #endif if (dst - buff[res] > MIN_PREFIX && Is_Dir_Sep(dst[-1])) dst[-1] = '\0'; /* remove last / or \ */ return buff[res]; } /*-------------------------------------------------------------------------* * PL_M_IS_ABSOLUTE_FILE_NAME * * * * Test if a path name is absolute (i.e. not relative). * *-------------------------------------------------------------------------*/ Bool Pl_M_Is_Absolute_File_Name(char *path) { if (Is_Dir_Sep(*path)) return TRUE; /* Windows: path strating with a drive specif is considered as absolute * (even if not followed by an antislash, e.g. c:foo is absolute). * Indeed, for a relative path, it is always * possible to add before it the current working directory and it is not * possible before a drive specif. * This is the behavior of Win32 PathIsRelative() function. * (to use it #include <shlwapi.h> and link with shlwapi.dll */ #if defined(_WIN32) || defined(__CYGWIN__) if (Has_Drive_Specif(path)) return TRUE; #endif return FALSE; } /*-------------------------------------------------------------------------* * PL_M_DECOMPOSE_FILE_NAME * * * * Decompose a path name into the dir, base and suffix (extension). * * * * path: the path to decompose * * del_trail_slashes: see below * * base: points the buffer which will receive the basename * * (or "" if none. It includes the suffix * * suffix: points inside base to the suffix part * * (or "" if none, i.e. at the end of base) * * returns the dirname part (or "" if none) * * * * Returned pointers are on 2 static buffers (dir and base) which can be * * written. * * * * del_trail_slashes: delete trailing slashes from dir ? * * FALSE: nothing is done (path is simply split into dir and base). * * Concatenating dir and base yields the complete pathname. * * TRUE: trailing slashes of the dir part are removed (similarly to * * dirname(3) except that initial trailing slashes of path are not * * removed). If the dir part is empty then "." is returned. * * Concatenating dir "/" and base yields a complete pathname. * * * * To remove the extension from base simply do *suffix = '\0' * * To add/change the suffix simply do strcpy(suffix, ".txt"); * *-------------------------------------------------------------------------*/ char * Pl_M_Decompose_File_Name(char *path, Bool del_trail_slashes, char **base, char **suffix) { static char buff_dir[MAXPATHLEN]; static char buff_base[MAXPATHLEN]; int dir_start_pos = 0; /* on _WIN32 maybe there is a drive specif */ #if 0 && defined(_WIN32) /* uncomment to explicitely use _splitpath() on Windows */ char direct[_MAX_DIR]; char ext[_MAX_EXT]; _splitpath(path, buff_dir, direct, buff_base, ext); /* buff_dir contains the drive */ dir_start_pos = strlen(buff_dir); strcat(buff_dir, direct); /* concat the dirname */ *suffix = buff_base + strlen(buff_base); /* buff_base contains the basename */ strcpy(*suffix, ext); /* concat the suffix */ #else /* This version works for both Windows and Unix */ char *p; strcpy(buff_dir, path); #if defined(_WIN32) || defined(__CYGWIN__) if (Has_Drive_Specif(buff_dir)) dir_start_pos = 2; #endif Find_Last_Dir_Sep(p, buff_dir); p = (p == NULL) ? buff_dir + dir_start_pos : p + 1; strcpy(buff_base, p); *p = '\0'; if ((p = strrchr(buff_base, '.')) != NULL) *suffix = p; else *suffix = buff_base + strlen(buff_base); /* i.e. suffix = "" */ #endif if (del_trail_slashes) { if (buff_dir[dir_start_pos] == '\0') /* if dir is empty it becomes "." */ strcat(buff_dir, "."); else { int len = strlen(buff_dir); /* remove all trailing / */ while(--len >= dir_start_pos && Is_Dir_Sep(buff_dir[len])) ; if (len < dir_start_pos) /* if all are / keep one */ len = dir_start_pos; buff_dir[len + 1] = '\0'; } } #if 0 /* uncomment to avoid extension with only one '.' */ if ((*suffix)[0] == '.' && (*suffix)[1] == '\0') /* not really a suffix: undo it */ (*suffix)++; /* points the \0 */ #endif *base = buff_base; return buff_dir; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/atom.h�������������������������������������������������������������������0000644�0001750�0001750�00000015737�13021324543�014735� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : atom.h * * Descr.: atom table management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #if 1 #define OPTIM_1_CHAR_ATOM #endif /*---------------------------------* * Constants * *---------------------------------*/ /* Character Classification */ #define LA 1 /* layout character */ #define SC 2 /* solo character */ #define QT 4 /* quote */ #define DQ 8 /* double quote */ #define BQ 16 /* back quote */ #define GR 32 /* graphic char */ #define PC 64 /* punctuation character */ #define DI 128 /* digit */ #define UL 256 /* underline */ #define CL 512 /* capital letter */ #define SL 1024 /* small letter */ #define CM 2048 /* comment character (%) */ #define EX 4096 /* extended character */ /* NB: (hash) atom table size should not be < ATOM_NIL (else module will change it) */ #define ATOM_NIL 256 /* Atom Type */ #define IDENTIFIER_ATOM 0 #define GRAPHIC_ATOM 1 #define SOLO_ATOM 2 #define OTHER_ATOM 3 #define Is_Valid_Code(c) ((PlULong) (c)-1 < 256-1) /* 1 <= c < 256 */ #define Is_Valid_Byte(c) ((PlULong) (c) < 256) /* 0 <= c < 256 */ #define Is_Valid_Atom(a) ((PlULong) (a) < pl_max_atom && \ pl_atom_tbl[(a)].name!=NULL) /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct /* Atom properties */ { /* ------------------------------ */ unsigned length:16; /* its length (in characters) */ unsigned op_mask:4; /* operator defined for the atom */ unsigned type:2; /* IDENTIFIER GRAPHIC SOLO OTHER */ unsigned needs_quote:1; /* needs ' around it ? */ unsigned needs_scan:1; /* contains ' or control char ? */ } AtomProp; typedef struct /* Atom information */ { /* ------------------------------ */ char *name; /* key is <name> (the string) */ unsigned hash; /* the hash code of string (name) */ AtomProp prop; /* associated properties */ void *info; /* an user info (used by g_var) */ } AtomInf; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef ATOM_FILE AtomInf *pl_atom_tbl; PlULong pl_max_atom; int pl_nb_atom; int pl_atom_void; int pl_atom_curly_brackets; int pl_atom_user; int pl_atom_system; int pl_atom_false; int pl_atom_true; int pl_atom_end_of_file; #ifdef META_TERM_HIDDEN int pl_atom_meta_term; #endif #ifndef OPTIM_1_CHAR_ATOM int atom_char[256]; #endif /* int pl_char_type[256]; see definition in atom.c */ char pl_char_conv[256]; /* char pl_escape_symbol[]; see definition in atom.c */ /* char pl_escape_char []; see definition in atom.c */ #else extern AtomInf *pl_atom_tbl; extern PlULong pl_max_atom; extern int pl_nb_atom; extern int pl_atom_void; extern int pl_atom_curly_brackets; extern int pl_atom_user; extern int pl_atom_system; extern int pl_atom_false; extern int pl_atom_true; extern int pl_atom_end_of_file; #ifdef META_TERM_HIDDEN extern int pl_atom_meta_term; #endif #ifndef OPTIM_1_CHAR_ATOM extern int atom_char[]; #endif extern char pl_char_conv[]; extern int pl_char_type[]; extern char pl_escape_symbol[]; extern char pl_escape_char[]; #endif PlLong pl_def_max_atom; /* overwritten if needed (see top_comp.c) */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Init_Atom(void); int Pl_Create_Allocate_Atom(char *name); int Pl_Create_Atom(char *name); WamWord FC Pl_Create_Atom_Tagged(char *name); int Pl_Find_Atom(char *name); int Pl_Gen_New_Atom(char *prefix); int Pl_Find_Next_Atom(int last_atom); #ifdef OPTIM_1_CHAR_ATOM #define ATOM_CHAR(c) ((int) (unsigned char) (c)) #else #define ATOM_CHAR(c) (atom_char[(int) (unsigned char) (c)]) #endif ���������������������������������gprolog-1.4.5/src/EnginePl/hash.c�������������������������������������������������������������������0000644�0001750�0001750�00000040415�13021324543�014702� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : hash.c * * Descr.: hash table management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #if 0 #define USE_ALONE #endif #ifdef USE_ALONE #include "hash.h" #define Malloc(size) malloc(size) #define Calloc(nb, size) calloc(nb, size) #define Realloc(ptr, size) realloc(ptr, size) #define Free(ptr) free(ptr) typedef long PlLong; #else #include "engine_pl.h" #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct hash_node *HashNode; struct hash_node { HashNode next; PlLong key; /* the rest of the elem comes here */ }; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static HashNode *Hash_Locate(HashNode *t, int tbl_size, PlLong key); #define HASH_STATIC_SIZE 3 #define Tbl_Size(t) (((int *)(t))[0]) #define Elem_Size(t) (((int *)(t))[1]) #define Nb_Elem(t) (((int *)(t))[2]) #define Hsh_Table(t) (((HashNode *) (t)) + HASH_STATIC_SIZE) #define Hash_Function(k, size) ((PlULong) (k) % (size)) /*-------------------------------------------------------------------------* * A hash table consists of a header (tbl_size, elem_size, nb_elem) and a * * table of tbl_size pointers to nodes. * * Each node records a pointer to the next node, and a user element whose * * size is elem_size. Each element must begin with the key (a PlLong). * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_HASH_ALLOC_TABLE * * * *-------------------------------------------------------------------------*/ char * Pl_Hash_Alloc_Table(int tbl_size, int elem_size) { char *tbl; tbl = (char *) Calloc(HASH_STATIC_SIZE + tbl_size, sizeof(HashNode)); #ifdef USE_ALONE if (tbl == NULL) return NULL; #endif if (tbl_size < 1) tbl_size = 1; /* at least one cell in a table */ Tbl_Size(tbl) = tbl_size; Elem_Size(tbl) = elem_size; Nb_Elem(tbl) = 0; return tbl; } /*-------------------------------------------------------------------------* * PL_HASH_REALLOC_TABLE * * * * NB: user information is not moved elsewhere * *-------------------------------------------------------------------------*/ char * Pl_Hash_Realloc_Table(char *tbl, int new_tbl_size) { int tbl_size = Tbl_Size(tbl); int elem_size = Elem_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *endt = t + tbl_size; HashNode p, p1; HashNode *prev; char *new_tbl; HashNode *new_t; if ((new_tbl = Pl_Hash_Alloc_Table(new_tbl_size, elem_size)) == NULL) return NULL; Nb_Elem(new_tbl) = Nb_Elem(tbl); new_t = Hsh_Table(new_tbl); do { p = *t; while (p) { /* here *prev==NULL */ prev = Hash_Locate(new_t, new_tbl_size, p->key); p1 = p; p = p->next; *prev = p1; p1->next = NULL; } } while (++t < endt); Free(tbl); return new_tbl; } /*-------------------------------------------------------------------------* * PL_HASH_FREE_TABLE * * * *-------------------------------------------------------------------------*/ void Pl_Hash_Free_Table(char *tbl) { int tbl_size = Tbl_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *endt = t + tbl_size; HashNode p, p1; do { p = *t; while (p) { p1 = p; p = p->next; Free(p1); } } while (++t < endt); Free(tbl); } /*-------------------------------------------------------------------------* * PL_HASH_DELETE_ALL * * * *-------------------------------------------------------------------------*/ void Pl_Hash_Delete_All(char *tbl) { int tbl_size = Tbl_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *endt = t + tbl_size; HashNode p, p1; do { p = *t; while (p) { p1 = p; p = p->next; Free(p1); } *t = NULL; } while (++t < endt); Nb_Elem(tbl) = 0; } /*-------------------------------------------------------------------------* * HASH_UPDATE * * * *-------------------------------------------------------------------------*/ char * Pl_Hash_Insert(char *tbl, char *elem, int replace) { int tbl_size = Tbl_Size(tbl); int elem_size = Elem_Size(tbl); HashNode *t = Hsh_Table(tbl); PlLong key = *(PlLong *) elem; HashNode *prev; HashNode p; prev = Hash_Locate(t, tbl_size, key); p = *prev; if (p == NULL) /* the key does not exist */ { p = (HashNode) Malloc(sizeof(struct hash_node) - sizeof(PlLong) + elem_size); #ifdef USE_ALONE if (p == NULL) return NULL; #endif p->next = NULL; Nb_Elem(tbl)++; *prev = p; } else if (!replace) goto finish; memcpy((char *) (&(p->key)), elem, elem_size); finish: return (char *) (&(p->key)); } /*-------------------------------------------------------------------------* * PL_HASH_FIND * * * *-------------------------------------------------------------------------*/ char * Pl_Hash_Find(char *tbl, PlLong key) { int tbl_size = Tbl_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *prev; HashNode p; prev = Hash_Locate(t, tbl_size, key); p = *prev; if (p == NULL) /* the key does not exist */ return NULL; return (char *) (&(p->key)); } /*-------------------------------------------------------------------------* * PL_HASH_DELETE * * * *-------------------------------------------------------------------------*/ char * Pl_Hash_Delete(char *tbl, PlLong key) { int tbl_size = Tbl_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *prev; HashNode p; prev = Hash_Locate(t, tbl_size, key); p = *prev; if (p == NULL) /* the key does not exist */ return NULL; *prev = p->next; Free(p); Nb_Elem(tbl)--; return tbl; } /*-------------------------------------------------------------------------* * HASH_LOCATE * * * * This function returns the address of the pointer to the node associated * * to the key (if the pointer is NULL the key is not in the table). * *-------------------------------------------------------------------------*/ static HashNode * Hash_Locate(HashNode *t, int tbl_size, PlLong key) { int n = Hash_Function(key, tbl_size); HashNode p; t += n; for (p = *t; p; p = p->next) { if (p->key == key) break; t = &p->next; } return t; } /*-------------------------------------------------------------------------* * PL_HASH_FIRST * * * * Hash_First and Hash_Next make it possible to scan a hash table. * * Example of use: * * * * HashScan scan; * * char *buff_ptr; * * * * for(buff_ptr=Pl_Hash_First(tbl,&scan); buff_ptr; * * buff_ptr=Pl_Hash_Next(&scan)) * * Display_Element(buff_ptr); * *-------------------------------------------------------------------------*/ char * Pl_Hash_First(char *tbl, HashScan *scan) { int tbl_size = Tbl_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *endt = t + tbl_size; scan->endt = (char *) endt; scan->cur_t = (char *) t; scan->cur_p = (char *) (*t); return Pl_Hash_Next(scan); } /*-------------------------------------------------------------------------* * PL_HASH_NEXT * * * *-------------------------------------------------------------------------*/ char * Pl_Hash_Next(HashScan *scan) { HashNode *t; HashNode *endt; HashNode p; p = (HashNode) (scan->cur_p); if (p) { scan->cur_p = (char *) (p->next); return (char *) (&(p->key)); } t = (HashNode *) (scan->cur_t); endt = (HashNode *) (scan->endt); while (++t < endt) { p = *t; if (p) { scan->cur_t = (char *) t; scan->cur_p = (char *) (p->next); return (char *) (&(p->key)); } } return NULL; } /*-------------------------------------------------------------------------* * PL_HASH_TABLE_SIZE * * * *-------------------------------------------------------------------------*/ int Pl_Hash_Table_Size(char *tbl) { return Tbl_Size(tbl); } /*-------------------------------------------------------------------------* * PL_HASH_NB_ELEMENTS * * * *-------------------------------------------------------------------------*/ int Pl_Hash_Nb_Elements(char *tbl) { return Nb_Elem(tbl); } #ifdef USE_ALONE /*-------------------------------------------------------------------------* * HASH_CHECK_TABLE * * * *-------------------------------------------------------------------------*/ void Hash_Check_Table(char *tbl) { int tbl_size = Tbl_Size(tbl); HashNode *t = Hsh_Table(tbl); HashNode *endt = t + tbl_size; HashNode p; int i = 0; do { printf("Hash Code:%d\n", t - Hsh_Table(tbl)); for (p = *t; p; p = p->next, i++) printf("\tadr:%#x key:%" PL_FMT_d "\n", (int) p, p->key); } while (++t < endt); if (i != Nb_Elem(tbl)) printf("Nb_Elem counter erroneous = %d insted of %d\n", Nb_Elem(tbl), i); } typedef struct { PlLong key; int info1; int info2; } Elem; /*-------------------------------------------------------------------------* * MAIN * * * * to compile alone active USE_ALONE and simply compile this file. * *-------------------------------------------------------------------------*/ int main(void) { char *t; int size; PlLong key; Elem elem, *p; HashScan scan; int c; int i = -1; int k; setbuf(stdout, NULL); printf("initial size: "); scanf("%d", &size); getchar(); t = Pl_Hash_Alloc_Table(size, sizeof(Elem)); if (t == NULL) printf("Cannot allocate the table\n"); for (;;) { printf ("\n1-Add/No Replace 2-Add/Replace 3-Find 4-Delete 5-DeleteAll\n"); printf("6-Scan Table 7-Exend Table 8-Check Integrity 9-End:"); scanf("%d", &c); getchar(); if (c == 9) break; if (c <= 4) { printf("Key:"); scanf("%" PL_FMT_d "", &key); getchar(); elem.key = key; } i = -i; switch (c) { case 1: case 2: elem.info1 = key * i * 10; elem.info2 = key * i * 100; printf("passed value: Key:%" PL_FMT_d " Info1:%d Info2:%d\n", elem.key, elem.info1, elem.info2); p = (Elem *) Pl_Hash_Insert(t, (char *) &elem, c - 1); break; break; case 3: p = (Elem *) Pl_Hash_Find(t, key); break; case 4: p = (Elem *) Pl_Hash_Delete(t, key); break; case 5: Pl_Hash_Delete_All(t); break; case 6: k = 0; for (p = (Elem *) Pl_Hash_First(t, &scan); p; p = (Elem *) Pl_Hash_Next(&scan)) { printf("adr: %#" PL_FMT_x " (Key:%" PL_FMT_d " Info1:%d Info2:%d)\n", (PlLong) p, p->key, p->info1, p->info2); k++; } if (k != Pl_Hash_Nb_Elements(t)) printf("# displayed elements: %d <> %d\n", k, Pl_Hash_Nb_Elements(t)); break; case 7: printf("new size: "); scanf("%d", &size); getchar(); t = Pl_Hash_Realloc_Table(t, size); if (t == NULL) printf("Cannot extend the table\n"); break; case 8: Hash_Check_Table(t); break; } if (c < 5) { if (p == NULL) printf("returned value: NULL\n"); else printf("returned value: %#" PL_FMT_x " (Key:%" PL_FMT_d " Info1:%d Info2:%d)\n", (PlLong) p, p->key, p->info1, p->info2); } printf("Nb Elements:%d\n", Pl_Hash_Nb_Elements(t)); } return 0; } #endif /* USE_ALONE */ ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/eng1-x86_64_win.s��������������������������������������������������������0000644�0001750�0001750�00000011640�13021324543�016440� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : eng1-x86_64_win.c * * Descr.: general engine (assembly part) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2011 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /* Replacement file for engine1.c for x86_64-win64 with MSVC * (MSVC 64 bits does not accept inline assembly) */ .text .p2align 4,,15 .globl Pl_Call_Compiled .def Pl_Call_Compiled; .scl 2; .type 32; .endef Pl_Call_Compiled: # reserve space (same as WamWord reserved_stack_space[1024]) subq $8200, %rsp # See comment in Ma2Asm/x86_64_any.c for stack alignment # this is better: # andq $0xfffffffffffffff0,%rsp # but yasm emits a buggy warning 'value does not fit in 32 bit field' # so we replace the 'and' by 2 'shifts' >> 4 << 4 sarq $4,%rsp # ensure 4 LSB are set to 0 salq $4,%rsp addq $8,%rsp # align stack movq pl_reg_bank(%rip), %r12 # set r12 to pl_reg_bank # branch to the Prolog code (codep in engine1.c) call *%rcx # normally will never return (longjmp instead) addq $8200, %rsp # thus this is not important ret /* .p2align 4,,15 .globl Pl_Set_Reg_Bank_Register .def Pl_Set_Reg_Bank_Register; .scl 2; .type 32; .endef Pl_Set_Reg_Bank_Register: movq pl_reg_bank(%rip), %r12 ret */ /* The following is commented because for the moment it works with Call_Prolog_Success/Call_Prolog_Fail in engine.c. Else, call these versions instead (and remove static from p_jumper decl in engine.c) .p2align 4,,15 .globl Pl_Call_Prolog_Fail .def Pl_Call_Prolog_Fail; .scl 2; .type 32; .endef Pl_Call_Prolog_Fail: subq $40, %rsp subq $8,%rsp movq p_jumper(%rip), %rcx movl $-1, %edx call longjmp .p2align 4,,15 .globl Pl_Call_Prolog_Success .def Pl_Call_Prolog_Success; .scl 2; .type 32; .endef Pl_Call_Prolog_Success: subq $40, %rsp subq $8,%rsp movq p_jumper(%rip), %rcx movl $1, %edx call longjmp .data .align 32 .comm p_jumper, 8, 4 */ ������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/pl_long.h����������������������������������������������������������������0000644�0001750�0001750�00000011160�13021324543�015411� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : wam_long.h * * Descr.: Wam long type definition * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _PL_LONG_H #define _PL_LONG_H #include <stdint.h> #include "gp_config.h" /* A PlLong can store an address: it is thus an intptr_t (depends on 32/64 bits arch) */ typedef intptr_t PlLong; typedef uintptr_t PlULong; #ifdef HAVE_INTTYPES_H #include <inttypes.h> #define PL_FMT_d PRIdPTR #define PL_FMT_u PRIuPTR #define PL_FMT_o PRIoPTR #define PL_FMT_x PRIxPTR /* Utilities to work on int64_t independently of the 32/64 bits of the arch */ #define FMT64_d PRId64 #define FMT64_u PRIu64 #define FMT64_o PRIo64 #define FMT64_x PRIx64 #else /* !HAVE_INTTYPES_H */ #if SIZEOF_LONG == SIZEOF_VOIDP # define __PL_FMT_PREFIX "l" #elif defined(_MSC_VER) # define __PL_FMT_PREFIX "I64" #else # define __PL_FMT_PREFIX "ll" #endif #define PL_FMT_d __PL_FMT_PREFIX "d" #define PL_FMT_u __PL_FMT_PREFIX "u" #define PL_FMT_o __PL_FMT_PREFIX "o" #define PL_FMT_x __PL_FMT_PREFIX "x" /* Utilities to work on int64_t independently of the 32/64 bits of the arch */ #ifdef _MSC_VER # define __FMT64_PREFIX "I64" #elif WORD_SIZE == 64 # define __FMT64_PREFIX "l" #else # define __FMT64_PREFIX "ll" #endif #define FMT64_d __FMT64_PREFIX "d" #define FMT64_u __FMT64_PREFIX "u" #define FMT64_o __FMT64_PREFIX "o" #define FMT64_x __FMT64_PREFIX "x" #endif /* !HAVE_INTTYPES_H */ /* --- strtol / strtoul --- */ #if SIZEOF_LONG == SIZEOF_VOIDP # define Str_To_PlLong(__str, __end, __base) strtol (__str, __end, __base) # define Str_To_PlULong(__str, __end, __base) strtoul(__str, __end, __base) #elif defined(__GNUC__) # define Str_To_PlLong(__str, __end, __base) strtoll (__str, __end, __base) # define Str_To_PlULong(__str, __end, __base) strtoull(__str, __end, __base) #else /* MSVC */ # define Str_To_PlLong(__str, __end, __base) _strtoi64 (__str, __end, __base) # define Str_To_PlULong(__str, __end, __base) _strtoui64(__str, __end, __base) #endif #endif /* !_PL_LONG_H */ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/obj_chain.h��������������������������������������������������������������0000644�0001750�0001750�00000007672�13021324543�015710� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : obj_chain.h * * Descr.: object chaining management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "gp_config.h" #include "pl_long.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Find_Linked_Objects(void); void Pl_New_Object(void (*fct_obj_init)(), void (*fct_exec_system) (), void (*fct_exec_user) ()); #ifdef OBJ_INIT static void OBJ_INIT(void); #define OBJ_CTOR CPP_CAT(OBJ_INIT,_ctor) #ifdef __GNUC__ static void __attribute__ ((constructor)) OBJ_CTOR(void) { Pl_New_Object(OBJ_INIT, NULL, NULL); } #else /* _MSC_VER */ static void OBJ_CTOR(void) { Pl_New_Object(OBJ_INIT, NULL, NULL); } #pragma data_seg(".GPLC$m") static PlLong obj_chain_start = (PlLong) OBJ_CTOR; #pragma data_seg() #endif /* _MSC_VER */ #endif /* OBJ_INIT */ #if (defined(_MSC_VER) || defined(M_darwin)) && !defined(OBJ_CHAIN_REVERSE_ORDER) #define OBJ_CHAIN_REVERSE_ORDER #endif #if 0 #define OBJ_CHAIN_REVERSE_ORDER #endif ����������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/WIN_SIGSEGV.c������������������������������������������������������������0000644�0001750�0001750�00000001570�13021324543�015602� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #include <windows.h> typedef long WamWord; #ifdef __CYGWIN__ #error CYGWIN not supported #endif LONG WINAPI Win32_Exception_Handler(LPEXCEPTION_POINTERS ei) { WamWord *addr; switch(ei->ExceptionRecord->ExceptionCode) { case EXCEPTION_ACCESS_VIOLATION: /* Windows SIGSEGV */ addr = (WamWord *) ei->ExceptionRecord->ExceptionInformation[1]; printf("Segmentation Violation at: %p\n", addr); exit(1); break; default: printf("UNKNOWN exception\n"); break; } return EXCEPTION_EXECUTE_HANDLER; } void Install_SIGSEGV_Handler(void); main() { long *x; Install_SIGSEGV_Handler(); // SetUnhandledExceptionFilter(Win32_Exception_Handler); x = (long *) 0xFEA4F124; *x = 12; } void Install_SIGSEGV_Handler(void) { SetUnhandledExceptionFilter(Win32_Exception_Handler); } ����������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/oper.c�������������������������������������������������������������������0000644�0001750�0001750�00000021353�13021324543�014724� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : oper.c * * Descr.: operator table management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #define OPER_FILE #include "engine_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define T_FX(p) PREFIX, p, 0 , p-1 #define T_FY(p) PREFIX, p, 0 , p #define T_XF(p) POSTFIX, p, p-1, 0 #define T_YF(p) POSTFIX, p, p, 0 #define T_XFX(p) INFIX, p, p-1, p-1 #define T_XFY(p) INFIX, p, p-1, p #define T_YFX(p) INFIX, p, p, p-1 #define ADD_OPER(prec, type, name) Pl_Create_Oper(Pl_Create_Atom(name), T_##type(prec)) /*-------------------------------------------------------------------------* * PL_INIT_OPER * * * *-------------------------------------------------------------------------*/ void Pl_Init_Oper(void) { pl_oper_tbl = Pl_Hash_Alloc_Table(START_OPER_TBL_SIZE, sizeof(OperInf)); ADD_OPER(1200, XFX, ":-"); ADD_OPER(1200, XFX, "-->"); ADD_OPER(1200, FX, ":-"); ADD_OPER(1150, FX, "discontiguous"); ADD_OPER(1150, FX, "dynamic"); ADD_OPER(1150, FX, "initialization"); ADD_OPER(1150, FX, "meta_predicate"); ADD_OPER(1150, FX, "multifile"); ADD_OPER(1150, FX, "public"); ADD_OPER(1105, XFY, "|"); ADD_OPER(1100, XFY, ";"); ADD_OPER(1050, XFY, "->"); ADD_OPER(1050, XFY, "*->"); ADD_OPER(1000, XFY, ","); ADD_OPER(900, FY, "\\+"); ADD_OPER(700, XFX, "="); ADD_OPER(700, XFX, "\\="); ADD_OPER(700, XFX, "=="); ADD_OPER(700, XFX, "\\=="); ADD_OPER(700, XFX, "@<"); ADD_OPER(700, XFX, "@>"); ADD_OPER(700, XFX, "@=<"); ADD_OPER(700, XFX, "@>="); ADD_OPER(700, XFX, "=.."); ADD_OPER(700, XFX, "as"); ADD_OPER(700, XFX, "is"); ADD_OPER(700, XFX, "=:="); ADD_OPER(700, XFX, "=\\="); ADD_OPER(700, XFX, "<"); ADD_OPER(700, XFX, "=<"); ADD_OPER(700, XFX, ">"); ADD_OPER(700, XFX, ">="); ADD_OPER(600, XFY, ":"); ADD_OPER(500, YFX, "+"); ADD_OPER(500, YFX, "-"); ADD_OPER(500, YFX, "/\\"); ADD_OPER(500, YFX, "\\/"); ADD_OPER(400, YFX, "*"); ADD_OPER(400, YFX, "/"); ADD_OPER(400, YFX, "//"); ADD_OPER(400, YFX, "rem"); ADD_OPER(400, YFX, "mod"); ADD_OPER(400, YFX, "div"); ADD_OPER(400, YFX, "<<"); ADD_OPER(400, YFX, ">>"); ADD_OPER(200, XFX, "**"); ADD_OPER(200, XFY, "^"); ADD_OPER(200, FY, "+"); ADD_OPER(200, FY, "-"); ADD_OPER(200, FY, "\\"); /* FD Operators */ ADD_OPER(750, XFY, "#<=>"); ADD_OPER(750, XFY, "#\\<=>"); ADD_OPER(740, XFY, "#==>"); ADD_OPER(740, XFY, "#\\==>"); ADD_OPER(730, XFY, "##"); ADD_OPER(730, YFX, "#\\/"); ADD_OPER(730, YFX, "#\\\\/"); ADD_OPER(720, YFX, "#/\\"); ADD_OPER(720, YFX, "#\\/\\"); ADD_OPER(710, FY, "#\\"); ADD_OPER(700, XFX, "#="); ADD_OPER(700, XFX, "#\\="); ADD_OPER(700, XFX, "#<"); ADD_OPER(700, XFX, "#=<"); ADD_OPER(700, XFX, "#>"); ADD_OPER(700, XFX, "#>="); ADD_OPER(700, XFX, "#=#"); ADD_OPER(700, XFX, "#\\=#"); ADD_OPER(700, XFX, "#<#"); ADD_OPER(700, XFX, "#=<#"); ADD_OPER(700, XFX, "#>#"); ADD_OPER(700, XFX, "#>=#"); } /*-------------------------------------------------------------------------* * PL_CREATE_OPER * * * *-------------------------------------------------------------------------*/ OperInf * Pl_Create_Oper(int atom_op, int type, int prec, int left, int right) { OperInf oper_info; OperInf *oper; Pl_Extend_Table_If_Needed(&pl_oper_tbl); oper_info.a_t = Make_Oper_Key(atom_op, type); oper_info.prec = prec; oper_info.left = left; oper_info.right = right; oper = (OperInf *) Pl_Hash_Insert(pl_oper_tbl, (char *) &oper_info, TRUE); pl_atom_tbl[atom_op].prop.op_mask |= Make_Op_Mask(type); return oper; } /*-------------------------------------------------------------------------* * PL_LOOKUP_OPER * * * *-------------------------------------------------------------------------*/ OperInf * Pl_Lookup_Oper(int atom_op, int type) { if (!Check_Oper(atom_op, type)) return NULL; return (OperInf *) Pl_Hash_Find(pl_oper_tbl, Make_Oper_Key(atom_op, type)); } /*-------------------------------------------------------------------------* * PL_LOOKUP_OPER_ANY_TYPE * * * *-------------------------------------------------------------------------*/ OperInf * Pl_Lookup_Oper_Any_Type(int atom_op) { int op_mask = pl_atom_tbl[atom_op].prop.op_mask; if (op_mask & Make_Op_Mask(PREFIX)) return (OperInf *) Pl_Hash_Find(pl_oper_tbl, Make_Oper_Key(atom_op, PREFIX)); if (op_mask & Make_Op_Mask(INFIX)) return (OperInf *) Pl_Hash_Find(pl_oper_tbl, Make_Oper_Key(atom_op, INFIX)); if (op_mask & Make_Op_Mask(POSTFIX)) return (OperInf *) Pl_Hash_Find(pl_oper_tbl, Make_Oper_Key(atom_op, POSTFIX)); return NULL; } /*-------------------------------------------------------------------------* * PL_DELETE_OPER * * * *-------------------------------------------------------------------------*/ OperInf * Pl_Delete_Oper(int atom_op, int type) { PlLong key = Make_Oper_Key(atom_op, type); pl_atom_tbl[atom_op].prop.op_mask &= ~Make_Op_Mask(type); return (OperInf *) Pl_Hash_Delete(pl_oper_tbl, key); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/LINUX_SIGSEGV.c����������������������������������������������������������0000644�0001750�0001750�00000002771�13021324543�016050� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <signal.h> #include <stdio.h> typedef long WamWord; #if 0 void SIGSEGV_Handler(int sig) { /* LINUX: recovering the bad address... */ /* There is no documented way to get the address that has */ /* caused SIGSEGV. I have looked at the sources of the kernel */ /* (files from /usr/src/linux/arch/i386/) */ /* */ /* mm/fault.c:104: current->tss.cr2 = address; */ /* a bad address is found by the memory manager. */ /* */ /* kernel/signal.c:203: put_user(current->tss.cr2, frame+23); */ /* a context pointed by 'frame' is created in the stack, */ /* it contains the bad addess at +23. */ /* Inside the handler SIGSEGV_Handler(int sig) the context */ /* (frame) can be found at &sig-1. */ long *frame = (long *) &sig - 1; WamWord *addr = (WamWord *) (frame[+23]); printf("Segmentation Violation at: %lx\n", addr); exit(1); } #else #include <asm/sigcontext.h> #if 0 void SIGSEGV_Handler(int sig, struct sigcontext_struct scp) #else void SIGSEGV_Handler(int sig, struct sigcontext scp) #endif { #if 1 WamWord *addr = (WamWord *) scp.cr2; printf("Segmentation Violation at: %lx\n", addr); #endif exit(1); } #endif main() { long *x; signal(SIGSEGV, (void (*)()) SIGSEGV_Handler); x = (long *) 0xffff040; *x = 12; } �������gprolog-1.4.5/src/EnginePl/gprolog.h����������������������������������������������������������������0000644�0001750�0001750�00000101162�13021324543�015432� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Foreign interface * * File : gprolog.h * * Descr.: GNU Prolog - general header file (for users) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _GPROLOG_H #include <stdint.h> #define _GPROLOG_H #ifdef __cplusplus extern "C" { #endif /* * Since GNU Prolog 1.4.0 C types 'long' have been replaced by PlLong * to work on X86_64/Windows (where long are 32-bits and not 64-bits). * New foreign code should use PlLong instead of long. * * Since GNU Prolog 1.3.1 all public names are prefixed with Pl_, PL_ or pl_ * so you should avoid these prefixes. * The names of C functions used in the foreign interface have been * renamed to start with the Pl_ prefix. To keep a bacward compatibility * with foreign code developed with gprolog < 1.3.1 macros are defined * for old names. * These macros can be deactivated if __GPROLOG_FOREIGN_STRICT__ is defined. * * #define __GPROLOG_FOREIGN_STRICT__ * #include <gprolog.h> */ /*---------------------------------* * Constants * *---------------------------------*/ #include "gprolog_cst.h" #define PL_RECOVER 0 #define PL_CUT 1 #define PL_KEEP_FOR_PROLOG 2 #define PL_FAILURE 0 #define PL_SUCCESS 1 #define PL_EXCEPTION 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef enum { PL_FALSE, PL_TRUE } PlBool; typedef intptr_t PlLong; typedef uintptr_t PlULong; typedef intptr_t PlTerm; typedef struct { PlBool is_var; PlBool unify; union { PlLong l; char *s; double d; } value; } PlFIOArg; /*---------------------------------* * Global Variables * *---------------------------------*/ extern int pl_foreign_bkt_counter; extern char *pl_foreign_bkt_buffer; extern int pl_type_atom; extern int pl_type_atomic; extern int pl_type_byte; extern int pl_type_callable; extern int pl_type_character; extern int pl_type_compound; extern int pl_type_evaluable; extern int pl_type_float; extern int pl_type_boolean; extern int pl_type_in_byte; extern int pl_type_in_character; extern int pl_type_integer; extern int pl_type_list; extern int pl_type_number; extern int pl_type_predicate_indicator; extern int pl_type_variable; /* deprecated: new code should emit an uninstantiation_error */ extern int pl_type_fd_variable; extern int pl_type_fd_evaluable; extern int pl_type_fd_bool_evaluable; extern int pl_domain_character_code_list; extern int pl_domain_close_option; extern int pl_domain_flag_value; extern int pl_domain_io_mode; extern int pl_domain_non_empty_list; extern int pl_domain_not_less_than_zero; extern int pl_domain_operator_priority; extern int pl_domain_operator_specifier; extern int pl_domain_prolog_flag; extern int pl_domain_read_option; extern int pl_domain_source_sink; extern int pl_domain_stream; extern int pl_domain_stream_option; extern int pl_domain_stream_or_alias; extern int pl_domain_stream_position; extern int pl_domain_stream_property; extern int pl_domain_write_option; extern int pl_domain_term_stream_or_alias; extern int pl_domain_g_array_index; extern int pl_domain_g_argument_selector; extern int pl_domain_stream_seek_method; extern int pl_domain_format_control_sequence; extern int pl_domain_os_path; extern int pl_domain_os_file_permission; extern int pl_domain_selectable_item; extern int pl_domain_date_time; extern int pl_existence_procedure; extern int pl_existence_source_sink; extern int pl_existence_stream; extern int pl_existence_sr_descriptor; extern int pl_permission_operation_access; extern int pl_permission_operation_close; extern int pl_permission_operation_create; extern int pl_permission_operation_input; extern int pl_permission_operation_modify; extern int pl_permission_operation_open; extern int pl_permission_operation_output; extern int pl_permission_operation_reposition; extern int pl_permission_type_binary_stream; extern int pl_permission_type_flag; extern int pl_permission_type_operator; extern int pl_permission_type_past_end_of_stream; extern int pl_permission_type_private_procedure; extern int pl_permission_type_static_procedure; extern int pl_permission_type_source_sink; extern int pl_permission_type_stream; extern int pl_permission_type_text_stream; extern int pl_representation_character; extern int pl_representation_character_code; extern int pl_representation_in_character_code; extern int pl_representation_max_arity; extern int pl_representation_max_integer; extern int pl_representation_min_integer; extern int pl_representation_too_many_variables; extern int pl_evluation_float_overflow; extern int pl_evluation_int_overflow; extern int pl_evluation_undefined; extern int pl_evluation_underflow; extern int pl_evluation_zero_divisor; extern int pl_resource_print_object_not_linked; extern int pl_resource_too_big_fd_constraint; /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Pl_Start_Prolog(int argc, char *argv[]); void Pl_Stop_Prolog(void); void Pl_Reset_Prolog(void); PlBool Pl_Try_Execute_Top_Level(void); #define Pl_Get_Choice_Counter() pl_foreign_bkt_counter #define Pl_Get_Choice_Buffer(t) ((t) pl_foreign_bkt_buffer) void Pl_No_More_Choice(void); char *Pl_Atom_Name(int atom); int Pl_Atom_Length(int atom); PlBool Pl_Atom_Needs_Quote(int atom); PlBool Pl_Atom_Needs_Scan(int atom); PlBool Pl_Is_Valid_Atom(int atom); int Pl_Create_Atom(const char *atom); int Pl_Create_Allocate_Atom(const char *atom); int Pl_Find_Atom(const char *atom); int Pl_Atom_Char(char c); int Pl_Atom_Nil(void); int Pl_Atom_User(void); int Pl_Atom_System(void); int Pl_Atom_False(void); int Pl_Atom_True(void); int Pl_Atom_End_Of_File(void); PlBool Pl_Unif(PlTerm term1, PlTerm term2); PlBool Pl_Unif_With_Occurs_Check(PlTerm term1, PlTerm term2); PlLong Pl_Rd_Integer_Check(PlTerm term); PlLong Pl_Rd_Integer(PlTerm term); PlLong Pl_Rd_Positive_Check(PlTerm term); PlLong Pl_Rd_Positive(PlTerm term); double Pl_Rd_Float_Check(PlTerm term); double Pl_Rd_Float(PlTerm term); double Pl_Rd_Number_Check(PlTerm term); double Pl_Rd_Number(PlTerm term); int Pl_Rd_Atom_Check(PlTerm term); int Pl_Rd_Atom(PlTerm term); int Pl_Rd_Boolean_Check(PlTerm term); int Pl_Rd_Boolean(PlTerm term); int Pl_Rd_Char_Check(PlTerm term); int Pl_Rd_Char(PlTerm term); int Pl_Rd_In_Char_Check(PlTerm term); int Pl_Rd_In_Char(PlTerm term); int Pl_Rd_Code_Check(PlTerm term); int Pl_Rd_Code(PlTerm term); int Pl_Rd_In_Code_Check(PlTerm term); int Pl_Rd_In_Code(PlTerm term); int Pl_Rd_Byte_Check(PlTerm term); int Pl_Rd_Byte(PlTerm term); int Pl_Rd_In_Byte_Check(PlTerm term); int Pl_Rd_In_Byte(PlTerm term); char *Pl_Rd_String_Check(PlTerm term); char *Pl_Rd_String(PlTerm term); char *Pl_Rd_Chars_Check(PlTerm term); char *Pl_Rd_Chars(PlTerm term); char *Pl_Rd_Codes_Check(PlTerm term); char *Pl_Rd_Codes(PlTerm term); int Pl_Rd_Chars_Str_Check(PlTerm term, char *str); int Pl_Rd_Chars_Str(PlTerm term, char *str); int Pl_Rd_Codes_Str_Check(PlTerm term, char *str); int Pl_Rd_Codes_Str(PlTerm term, char *str); PlTerm *Pl_Rd_List_Check(PlTerm term); PlTerm *Pl_Rd_List(PlTerm term); int Pl_Rd_Proper_List_Check(PlTerm term, PlTerm *arg); int Pl_Rd_Proper_List(PlTerm term, PlTerm *arg); PlTerm *Pl_Rd_Compound_Check(PlTerm term, int *func, int *arity); PlTerm *Pl_Rd_Compound(PlTerm term, int *func, int *arity); PlTerm *Pl_Rd_Callable_Check(PlTerm term, int *func, int *arity); PlTerm *Pl_Rd_Callable(PlTerm term, int *func, int *arity); void Pl_Check_For_Un_Integer(PlTerm term); void Pl_Check_For_Un_Positive(PlTerm term); void Pl_Check_For_Un_Float(PlTerm term); void Pl_Check_For_Un_Number(PlTerm term); void Pl_Check_For_Un_Atom(PlTerm term); void Pl_Check_For_Un_Boolean(PlTerm term); void Pl_Check_For_Un_Char(PlTerm term); void Pl_Check_For_Un_In_Char(PlTerm term); void Pl_Check_For_Un_Code(PlTerm term); void Pl_Check_For_Un_In_Code(PlTerm term); void Pl_Check_For_Un_Byte(PlTerm term); void Pl_Check_For_Un_In_Byte(PlTerm term); void Pl_Check_For_Un_String(PlTerm term); void Pl_Check_For_Un_Chars(PlTerm term); void Pl_Check_For_Un_Codes(PlTerm term); void Pl_Check_For_Un_List(PlTerm term); void Pl_Check_For_Un_Compound(PlTerm term); void Pl_Check_For_Un_Callable(PlTerm term); void Pl_Check_For_Un_Variable(PlTerm term); PlBool Pl_Un_Integer_Check(PlLong value, PlTerm term); PlBool Pl_Un_Integer(PlLong value, PlTerm term); PlBool Pl_Un_Positive_Check(PlLong value, PlTerm term); PlBool Pl_Un_Positive(PlLong value, PlTerm term); PlBool Pl_Un_Float_Check(double value, PlTerm term); PlBool Pl_Un_Float(double value, PlTerm term); PlBool Pl_Un_Number_Check(double value, PlTerm term); PlBool Pl_Un_Number(double value, PlTerm term); PlBool Pl_Un_Atom_Check(int value, PlTerm term); PlBool Pl_Un_Atom(int value, PlTerm term); PlBool Pl_Un_Boolean_Check(int value, PlTerm term); PlBool Pl_Un_Boolean(int value, PlTerm term); PlBool Pl_Un_Char_Check(int value, PlTerm term); PlBool Pl_Un_Char(int value, PlTerm term); PlBool Pl_Un_In_Char_Check(int value, PlTerm term); PlBool Pl_Un_In_Char(int value, PlTerm term); PlBool Pl_Un_Code_Check(int value, PlTerm term); PlBool Pl_Un_Code(int value, PlTerm term); PlBool Pl_Un_In_Code_Check(int value, PlTerm term); PlBool Pl_Un_In_Code(int value, PlTerm term); PlBool Pl_Un_Byte_Check(int value, PlTerm term); PlBool Pl_Un_Byte(int value, PlTerm term); PlBool Pl_Un_In_Byte_Check(int value, PlTerm term); PlBool Pl_Un_In_Byte(int value, PlTerm term); PlBool Pl_Un_String_Check(const char *value, PlTerm term); PlBool Pl_Un_String(const char *value, PlTerm term); PlBool Pl_Un_Chars_Check(const char *value, PlTerm term); PlBool Pl_Un_Chars(const char *value, PlTerm term); PlBool Pl_Un_Codes_Check(const char *value, PlTerm term); PlBool Pl_Un_Codes(const char *value, PlTerm term); PlBool Pl_Un_List_Check(PlTerm *arg, PlTerm term); PlBool Pl_Un_List(PlTerm *arg, PlTerm term); PlBool Pl_Un_Proper_List_Check(int n, PlTerm *arg, PlTerm term); PlBool Pl_Un_Proper_List(int n, PlTerm *arg, PlTerm term); PlBool Pl_Un_Compound_Check(int func, int arity, PlTerm *arg, PlTerm term); PlBool Pl_Un_Compound(int func, int arity, PlTerm *arg, PlTerm term); PlBool Pl_Un_Callable_Check(int func, int arity, PlTerm *arg, PlTerm term); PlBool Pl_Un_Callable(int func, int arity, PlTerm *arg, PlTerm term); PlBool Pl_Un_Term(PlTerm term1, PlTerm term2); PlTerm Pl_Mk_Integer(PlLong value); PlTerm Pl_Mk_Positive(PlLong value); PlTerm Pl_Mk_Float(double value); PlTerm Pl_Mk_Number(double value); PlTerm Pl_Mk_Atom(int value); PlTerm Pl_Mk_Boolean(int value); PlTerm Pl_Mk_Char(int value); PlTerm Pl_Mk_In_Char(int value); PlTerm Pl_Mk_Code(int value); PlTerm Pl_Mk_In_Code(int value); PlTerm Pl_Mk_Byte(int value); PlTerm Pl_Mk_In_Byte(int value); PlTerm Pl_Mk_String(const char *value); PlTerm Pl_Mk_Chars(const char *value); PlTerm Pl_Mk_Codes(const char *value); PlTerm Pl_Mk_List(const PlTerm *arg); PlTerm Pl_Mk_Proper_List(int n, const PlTerm *arg); PlTerm Pl_Mk_Compound(int func, int arity, const PlTerm *arg); PlTerm Pl_Mk_Callable(int func, int arity, const PlTerm *arg); PlTerm Pl_Mk_Variable(void); int Pl_Type_Of_Term(PlTerm term); int Pl_List_Length(PlTerm list); PlLong Pl_Term_Compare(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Var(PlTerm term); PlBool Pl_Builtin_Non_Var(PlTerm term); PlBool Pl_Builtin_Atom(PlTerm term); PlBool Pl_Builtin_Integer(PlTerm term); PlBool Pl_Builtin_Float(PlTerm term); PlBool Pl_Builtin_Number(PlTerm term); PlBool Pl_Builtin_Atomic(PlTerm term); PlBool Pl_Builtin_Compound(PlTerm term); PlBool Pl_Builtin_Callable(PlTerm term); PlBool Pl_Builtin_Fd_Var(PlTerm term); PlBool Pl_Builtin_Non_Fd_Var(PlTerm term); PlBool Pl_Builtin_Generic_Var(PlTerm term); PlBool Pl_Builtin_Non_Generic_Var(PlTerm term); PlBool Pl_Builtin_List(PlTerm term); PlBool Pl_Builtin_Partial_List(PlTerm term); PlBool Pl_Builtin_List_Or_Partial_List(PlTerm term); PlBool Pl_Builtin_Term_Eq(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Term_Neq(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Term_Lt(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Term_Lte(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Term_Gt(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Term_Gte(PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Compare(PlTerm cmp, PlTerm term1, PlTerm term2); PlBool Pl_Builtin_Arg(PlTerm arg_no, PlTerm term, PlTerm sub_term); PlBool Pl_Builtin_Functor(PlTerm term, PlTerm functor, PlTerm arity); PlBool Pl_Builtin_Univ(PlTerm term, PlTerm list); PlBool Pl_Builtin_Eq(PlTerm expr1, PlTerm expr2); PlBool Pl_Builtin_Neq(PlTerm expr1, PlTerm expr2); PlBool Pl_Builtin_Lt(PlTerm expr1, PlTerm expr2); PlBool Pl_Builtin_Lte(PlTerm expr1, PlTerm expr2); PlBool Pl_Builtin_Gt(PlTerm expr1, PlTerm expr2); PlBool Pl_Builtin_Gte(PlTerm expr1, PlTerm expr2); void Pl_Math_Evaluate(PlTerm expr, PlTerm *result); int Pl_Term_Size(PlTerm term); void Pl_Copy_Term(PlTerm *dst_term, PlTerm *src_term); void Pl_Copy_Contiguous_Term(PlTerm *dst_term, PlTerm *src_term); void Pl_Set_C_Bip_Name(const char *functor, int arity); void Pl_Unset_C_Bip_Name(void); void Pl_Err_Instantiation(void); void Pl_Err_Type(int atom_type, PlTerm term); void Pl_Err_Domain(int atom_domain, PlTerm term); void Pl_Err_Existence(int atom_object, PlTerm term); void Pl_Err_Permission(int atom_oper, int atom_perm, PlTerm term); void Pl_Err_Representation(int atom_flag); void Pl_Err_Evaluation(int pl_atom_error); void Pl_Err_Resource(int atom_resource); void Pl_Err_Syntax(int pl_atom_error); void Pl_Err_System(int pl_atom_error); void Pl_Emit_Syntax_Error(char *file_name, int err_line, int err_col, char *err_msg); void Pl_Os_Error(void); void Pl_Write(PlTerm term); char *Pl_Write_To_String(PlTerm term); char *Pl_Writeq_To_String(PlTerm term); char *Pl_Write_Canonical_To_String(PlTerm term); char *Pl_Display_To_String(PlTerm term); PlTerm Pl_Read_From_String(const char *str); void Pl_Exec_Continuation(int func, int arity, PlTerm *arg_adr); void Pl_Throw(PlTerm ball); void Pl_Query_Begin(PlBool recoverable); int Pl_Query_Call(int func, int arity, PlTerm *arg_adr); int Pl_Query_Start(int func, int arity, PlTerm *arg_adr, PlBool recoverable); int Pl_Query_Next_Solution(void); void Pl_Query_End(int op); PlTerm Pl_Get_Exception(void); #define PL_PLV PL_REF /*-------------------------------------------------------------------------* * Deprecated API * * * * For backward compatibility purpose only. New code should use new API. * *-------------------------------------------------------------------------*/ #ifndef __GPROLOG_FOREIGN_STRICT__ #ifdef FALSE # if FALSE != 0 # error "FALSE already defined with a value != 0" # endif #else #define FALSE 0 #endif #ifdef TRUE # if TRUE != 1 # error "TRUE already defined with a value != 1" # endif #else #define TRUE 1 #endif #ifndef Bool typedef PlBool Bool; #endif typedef PlFIOArg FIOArg; #define type_atom pl_type_atom #define type_atomic pl_type_atomic #define type_byte pl_type_byte #define type_callable pl_type_callable #define type_character pl_type_character #define type_compound pl_type_compound #define type_evaluable pl_type_evaluable #define type_float pl_type_float #define type_boolean pl_type_boolean #define type_in_byte pl_type_in_byte #define type_in_character pl_type_in_character #define type_integer pl_type_integer #define type_list pl_type_list #define type_number pl_type_number #define type_predicate_indicator pl_type_predicate_indicator #define type_variable pl_type_variable /* deprecated: new code should emit an uninstantiation_error */ #define type_fd_variable pl_type_fd_variable #define type_fd_evaluable pl_type_fd_evaluable #define type_fd_bool_evaluable pl_type_fd_bool_evaluable #define domain_character_code_list pl_domain_character_code_list #define domain_close_option pl_domain_close_option #define domain_flag_value pl_domain_flag_value #define domain_io_mode pl_domain_io_mode #define domain_non_empty_list pl_domain_non_empty_list #define domain_not_less_than_zero pl_domain_not_less_than_zero #define domain_operator_priority pl_domain_operator_priority #define domain_operator_specifier pl_domain_operator_specifier #define domain_prolog_flag pl_domain_prolog_flag #define domain_read_option pl_domain_read_option #define domain_source_sink pl_domain_source_sink #define domain_stream pl_domain_stream #define domain_stream_option pl_domain_stream_option #define domain_stream_or_alias pl_domain_stream_or_alias #define domain_stream_position pl_domain_stream_position #define domain_stream_property pl_domain_stream_property #define domain_write_option pl_domain_write_option #define domain_term_stream_or_alias pl_domain_term_stream_or_alias #define domain_g_array_index pl_domain_g_array_index #define domain_g_argument_selector pl_domain_g_argument_selector #define domain_stream_seek_method pl_domain_stream_seek_method #define domain_format_control_sequence pl_domain_format_control_sequence #define domain_os_path pl_domain_os_path #define domain_os_file_permission pl_domain_os_file_permission #define domain_selectable_item pl_domain_selectable_item #define domain_date_time pl_domain_date_time #define existence_procedure pl_existence_procedure #define existence_source_sink pl_existence_source_sink #define existence_stream pl_existence_stream #define existence_sr_descriptor pl_existence_sr_descriptor #define permission_operation_access pl_permission_operation_access #define permission_operation_close pl_permission_operation_close #define permission_operation_create pl_permission_operation_create #define permission_operation_input pl_permission_operation_input #define permission_operation_modify pl_permission_operation_modify #define permission_operation_open pl_permission_operation_open #define permission_operation_output pl_permission_operation_output #define permission_operation_reposition pl_permission_operation_reposition #define permission_type_binary_stream pl_permission_type_binary_stream #define permission_type_flag pl_permission_type_flag #define permission_type_operator pl_permission_type_operator #define permission_type_past_end_of_stream pl_permission_type_past_end_of_stream #define permission_type_private_procedure pl_permission_type_private_procedure #define permission_type_static_procedure pl_permission_type_static_procedure #define permission_type_source_sink pl_permission_type_source_sink #define permission_type_stream pl_permission_type_stream #define permission_type_text_stream pl_permission_type_text_stream #define representation_character pl_representation_character #define representation_character_code pl_representation_character_code #define representation_in_character_code pl_representation_in_character_code #define representation_max_arity pl_representation_max_arity #define representation_max_integer pl_representation_max_integer #define representation_min_integer pl_representation_min_integer #define representation_too_many_variables pl_representation_too_many_variables #define evluation_float_overflow pl_evluation_float_overflow #define evluation_int_overflow pl_evluation_int_overflow #define evluation_undefined pl_evluation_undefined #define evluation_underflow pl_evluation_underflow #define evluation_zero_divisor pl_evluation_zero_divisor #define resource_print_object_not_linked pl_resource_print_object_not_linked #define resource_too_big_fd_constraint pl_resource_too_big_fd_constraint #define Start_Prolog(argc, argv) Pl_Start_Prolog(argc, argv) #define Stop_Prolog() Pl_Stop_Prolog() #define Reset_Prolog() Pl_Reset_Prolog() #define Try_Execute_Top_Level() Pl_Try_Execute_Top_Level() #define Get_Choice_Counter() Pl_Get_Choice_Counter() #define Get_Choice_Buffer(t) Pl_Get_Choice_Buffer(t) #define No_More_Choice() Pl_No_More_Choice() #define Atom_Name(a) Pl_Atom_Name(a) #define Atom_Length(a) Pl_Atom_Length(a) #define Atom_Needs_Quote(a) Pl_Atom_Needs_Quote(a) #define Atom_Needs_Scan(a) Pl_Atom_Needs_Scan(a) #define Is_Valid_Atom(a) Pl_Is_Valid_Atom(a) #define Create_Atom(a) Pl_Create_Atom(a) #define Create_Allocate_Atom(a) Pl_Create_Allocate_Atom(a) #define Find_Atom(a) Pl_Find_Atom(a) #define ATOM_CHAR(c) Pl_Atom_Char(c) #define atom_nil Pl_Atom_Nil() #define atom_false Pl_Atom_False() #define atom_true Pl_Atom_True() #define atom_end_of_file Pl_Atom_End_Of_File() #define Rd_Integer_Check(term) Pl_Rd_Integer_Check(term) #define Rd_Integer(term) Pl_Rd_Integer(term) #define Rd_Positive_Check(term) Pl_Rd_Positive_Check(term) #define Rd_Positive(term) Pl_Rd_Positive(term) #define Rd_Float_Check(term) Pl_Rd_Float_Check(term) #define Rd_Float(term) Pl_Rd_Float(term) #define Rd_Number_Check(term) Pl_Rd_Number_Check(term) #define Rd_Number(term) Pl_Rd_Number(term) #define Rd_Atom_Check(term) Pl_Rd_Atom_Check(term) #define Rd_Atom(term) Pl_Rd_Atom(term) #define Rd_Boolean_Check(term) Pl_Rd_Boolean_Check(term) #define Rd_Boolean(term) Pl_Rd_Boolean(term) #define Rd_Char_Check(term) Pl_Rd_Char_Check(term) #define Rd_Char(term) Pl_Rd_Char(term) #define Rd_In_Char_Check(term) Pl_Rd_In_Char_Check(term) #define Rd_In_Char(term) Pl_Rd_In_Char(term) #define Rd_Code_Check(term) Pl_Rd_Code_Check(term) #define Rd_Code(term) Pl_Rd_Code(term) #define Rd_In_Code_Check(term) Pl_Rd_In_Code_Check(term) #define Rd_In_Code(term) Pl_Rd_In_Code(term) #define Rd_Byte_Check(term) Pl_Rd_Byte_Check(term) #define Rd_Byte(term) Pl_Rd_Byte(term) #define Rd_In_Byte_Check(term) Pl_Rd_In_Byte_Check(term) #define Rd_In_Byte(term) Pl_Rd_In_Byte(term) #define Rd_String_Check(term) Pl_Rd_String_Check(term) #define Rd_String(term) Pl_Rd_String(term) #define Rd_Chars_Check(term) Pl_Rd_Chars_Check(term) #define Rd_Chars(term) Pl_Rd_Chars(term) #define Rd_Codes_Check(term) Pl_Rd_Codes_Check(term) #define Rd_Codes(term) Pl_Rd_Codes(term) #define Rd_Chars_Str_Check(term, str) Pl_Rd_Chars_Str_Check(term, str) #define Rd_Chars_Str(term, str) Pl_Rd_Chars_Str(term, str) #define Rd_Codes_Str_Check(term, str) Pl_Rd_Codes_Str_Check(term, str) #define Rd_Codes_Str(term, str) Pl_Rd_Codes_Str(term, str) #define Rd_List_Check(term) Pl_Rd_List_Check(term) #define Rd_List(term) Pl_Rd_List(term) #define Rd_Proper_List_Check(term, arg) Pl_Rd_Proper_List_Check(term, arg) #define Rd_Proper_List(term, arg) Pl_Rd_Proper_List(term, arg) #define Rd_Compound_Check(term, func, arity) Pl_Rd_Compound_Check(term, func, arity) #define Rd_Compound(term, func, arity) Pl_Rd_Compound(term, func, arity) #define Rd_Callable_Check(term, func, arity) Pl_Rd_Callable_Check(term, func, arity) #define Rd_Callable(term, func, arity) Pl_Rd_Callable(term, func, arity) #define Check_For_Un_Integer(term) Pl_Check_For_Un_Integer(term) #define Check_For_Un_Positive(term) Pl_Check_For_Un_Positive(term) #define Check_For_Un_Float(term) Pl_Check_For_Un_Float(term) #define Check_For_Un_Number(term) Pl_Check_For_Un_Number(term) #define Check_For_Un_Atom(term) Pl_Check_For_Un_Atom(term) #define Check_For_Un_Boolean(term) Pl_Check_For_Un_Boolean(term) #define Check_For_Un_Char(term) Pl_Check_For_Un_Char(term) #define Check_For_Un_In_Char(term) Pl_Check_For_Un_In_Char(term) #define Check_For_Un_Code(term) Pl_Check_For_Un_Code(term) #define Check_For_Un_In_Code(term) Pl_Check_For_Un_In_Code(term) #define Check_For_Un_Byte(term) Pl_Check_For_Un_Byte(term) #define Check_For_Un_In_Byte(term) Pl_Check_For_Un_In_Byte(term) #define Check_For_Un_String(term) Pl_Check_For_Un_String(term) #define Check_For_Un_Chars(term) Pl_Check_For_Un_Chars(term) #define Check_For_Un_Codes(term) Pl_Check_For_Un_Codes(term) #define Check_For_Un_List(term) Pl_Check_For_Un_List(term) #define Check_For_Un_Compound(term) Pl_Check_For_Un_Compound(term) #define Check_For_Un_Callable(term) Pl_Check_For_Un_Callable(term) #define Check_For_Un_Variable(term) Pl_Check_For_Un_Variable(term) #define Un_Integer_Check(value, term) Pl_Un_Integer_Check(value, term) #define Un_Integer(value, term) Pl_Un_Integer(value, term) #define Un_Positive_Check(value, term) Pl_Un_Positive_Check(value, term) #define Un_Positive(value, term) Pl_Un_Positive(value, term) #define Un_Float_Check(value, term) Pl_Un_Float_Check(value, term) #define Un_Float(value, term) Pl_Un_Float(value, term) #define Un_Number_Check(value, term) Pl_Un_Number_Check(value, term) #define Un_Number(value, term) Pl_Un_Number(value, term) #define Un_Atom_Check(value, term) Pl_Un_Atom_Check(value, term) #define Un_Atom(value, term) Pl_Un_Atom(value, term) #define Un_Boolean_Check(value, term) Pl_Un_Boolean_Check(value, term) #define Un_Boolean(value, term) Pl_Un_Boolean(value, term) #define Un_Char_Check(value, term) Pl_Un_Char_Check(value, term) #define Un_Char(value, term) Pl_Un_Char(value, term) #define Un_In_Char_Check(value, term) Pl_Un_In_Char_Check(value, term) #define Un_In_Char(value, term) Pl_Un_In_Char(value, term) #define Un_Code_Check(value, term) Pl_Un_Code_Check(value, term) #define Un_Code(value, term) Pl_Un_Code(value, term) #define Un_In_Code_Check(value, term) Pl_Un_In_Code_Check(value, term) #define Un_In_Code(value, term) Pl_Un_In_Code(value, term) #define Un_Byte_Check(value, term) Pl_Un_Byte_Check(value, term) #define Un_Byte(value, term) Pl_Un_Byte(value, term) #define Un_In_Byte_Check(value, term) Pl_Un_In_Byte_Check(value, term) #define Un_In_Byte(value, term) Pl_Un_In_Byte(value, term) #define Un_String_Check(value, term) Pl_Un_String_Check(value, term) #define Un_String(value, term) Pl_Un_String(value, term) #define Un_Chars_Check(value, term) Pl_Un_Chars_Check(value, term) #define Un_Chars(value, term) Pl_Un_Chars(value, term) #define Un_Codes_Check(value, term) Pl_Un_Codes_Check(value, term) #define Un_Codes(value, term) Pl_Un_Codes(value, term) #define Un_List_Check(arg, term) Pl_Un_List_Check(arg, term) #define Un_List(arg, term) Pl_Un_List(arg, term) #define Un_Proper_List_Check(n, arg, term) Pl_Un_Proper_List_Check(n, arg, term) #define Un_Proper_List(n, arg, term) Pl_Un_Proper_List(n, arg, term) #define Un_Compound_Check(func, arity, arg, term) Pl_Un_Compound_Check(func, arity, arg, term) #define Un_Compound(func, arity, arg, term) Pl_Un_Compound(func, arity, arg, term) #define Un_Callable_Check(func, arity, arg, term) Pl_Un_Callable_Check(func, arity, arg, term) #define Un_Callable(func, arity, arg, term) Pl_Un_Callable(func, arity, arg, term) #define Un_Term(term1, term2) Pl_Un_Term(term1, term2) #define Mk_Integer(value) Pl_Mk_Integer(value) #define Mk_Positive(value) Pl_Mk_Positive(value) #define Mk_Float(value) Pl_Mk_Float(value) #define Mk_Number(value) Pl_Mk_Number(value) #define Mk_Atom(value) Pl_Mk_Atom(value) #define Mk_Boolean(value) Pl_Mk_Boolean(value) #define Mk_Char(value) Pl_Mk_Char(value) #define Mk_In_Char(value) Pl_Mk_In_Char(value) #define Mk_Code(value) Pl_Mk_Code(value) #define Mk_In_Code(value) Pl_Mk_In_Code(value) #define Mk_Byte(value) Pl_Mk_Byte(value) #define Mk_In_Byte(value) Pl_Mk_In_Byte(value) #define Mk_String(value) Pl_Mk_String(value) #define Mk_Chars(value) Pl_Mk_Chars(value) #define Mk_Codes(value) Pl_Mk_Codes(value) #define Mk_List(arg) Pl_Mk_List(arg) #define Mk_Proper_List(n, arg) Pl_Mk_Proper_List(n, arg) #define Mk_Compound(func, arity, arg) Pl_Mk_Compound(func, arity, arg) #define Mk_Callable(func, arity, arg) Pl_Mk_Callable(func, arity, arg) #define Mk_Variable() Pl_Mk_Variable() #define Blt_Var(term) Pl_Builtin_Var(term) #define Blt_Non_Var(term) Pl_Builtin_Non_Var(term) #define Blt_Atom(term) Pl_Builtin_Atom(term) #define Blt_Integer(term) Pl_Builtin_Integer(term) #define Blt_Float(term) Pl_Builtin_Float(term) #define Blt_Number(term) Pl_Builtin_Number(term) #define Blt_Atomic(term) Pl_Builtin_Atomic(term) #define Blt_Compound(term) Pl_Builtin_Compound(term) #define Blt_Callable(term) Pl_Builtin_Callable(term) #define Blt_Fd_Var(term) Pl_Builtin_Fd_Var(term) #define Blt_Non_Fd_Var(term) Pl_Builtin_Non_Fd_Var(term) #define Blt_Generic_Var(term) Pl_Builtin_Generic_Var(term) #define Blt_Non_Generic_Var(term) Pl_Builtin_Non_Generic_Var(term) #define Blt_List(term) Pl_Builtin_List(term) #define Blt_Partial_List(term) Pl_Builtin_Partial_List(term) #define Blt_List_Or_Partial_List(term) Pl_Builtin_List_Or_Partial_List(term) #define Blt_Term_Eq(term1, term2) Pl_Builtin_Term_Eq(term1, term2) #define Blt_Term_Neq(term1, term2) Pl_Builtin_Term_Neq(term1, term2) #define Blt_Term_Lt(term1, term2) Pl_Builtin_Term_Lt(term1, term2) #define Blt_Term_Lte(term1, term2) Pl_Builtin_Term_Lte(term1, term2) #define Blt_Term_Gt(term1, term2) Pl_Builtin_Term_Gt(term1, term2) #define Blt_Term_Gte(term1, term2) Pl_Builtin_Term_Gte(term1, term2) #define Blt_Eq(expr1, expr2) Pl_Builtin_Eq(expr1, expr2) #define Blt_Neq(expr1, expr2) Pl_Builtin_Neq(expr1, expr2) #define Blt_Lt(expr1, expr2) Pl_Builtin_Lt(expr1, expr2) #define Blt_Lte(expr1, expr2) Pl_Builtin_Lte(expr1, expr2) #define Blt_Gt(expr1, expr2) Pl_Builtin_Gt(expr1, expr2) #define Blt_Gte(expr1, expr2) Pl_Builtin_Gte(expr1, expr2) #define Math_Load_Value(expr, result) Pl_Math_Evaluate(expr, result) #define Type_Of_Term(term) Pl_Type_Of_Term(term) #define Term_Size(term) Pl_Term_Size(term) #define Copy_Term(dst_term, src_term) Pl_Copy_Term(dst_term, src_term) #define Copy_Contiguous_Term(dst_term, src_term) Pl_Copy_Contiguous_Term(dst_term, src_term) #define Set_C_Bip_Name(functor, arity) Pl_Set_C_Bip_Name(functor, arity) #define Unset_C_Bip_Name() Pl_Unset_C_Bip_Name() #define Emit_Syntax_Error(file_name, err_line, err_col, err_msg) \ Pl_Emit_Syntax_Error(file_name, err_line, err_col, err_msg) #define Os_Error() Pl_Os_Error() #define PLV PL_PLV #define FDV PL_FDV #define INT PL_INT #define FLT PL_FLT #define ATM PL_ATM #define LST PL_LST #define STC PL_STC #define INT_LOWEST_VALUE PL_MIN_INTEGER #define INT_GREATEST_VALUE PL_MAX_INTEGER #define Unify(term1, term2) Pl_Unif(term1, term2) #define Unify_With_Occurs_Check(term1, term2) Pl_Unif_With_Occurs_Check(term1, term2) #endif /* !__GPROLOG_FOREIGN_STRICT__ */ #ifdef __cplusplus } #endif #endif /* !_GPROLOG_H */ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/.gitignore���������������������������������������������������������������0000644�0001750�0001750�00000000304�13021324543�015574� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile gp_config.h gprolog_cst.h cpp_headers pl_config wam_archi.h wam_regs.h wam_stacks.h gprolog_cst.h try_sigaction DO_CPP_HEADERS test_oc MMAP.c TEST_CTRLC.c TIME_MEASURE.c GCC_CHAIN_OBJ.c ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/hash_fct.h���������������������������������������������������������������0000644�0001750�0001750�00000007056�13021324543�015547� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : hash_fct.c * * Descr.: hash function * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _HASH_FCT_H #define _HASH_FCT_H #include <stdint.h> /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int len; uint32_t hash; } HashIncrInfo; /*---------------------------------* * Function Prototypes * *---------------------------------*/ uint32_t Pl_Hash_Buffer(const void *data, int len); void Pl_Hash_Incr_Init(HashIncrInfo *hi); void Pl_Hash_Incr_Buffer(HashIncrInfo *hi, const void *data, int len); void Pl_Hash_Incr_Int32(HashIncrInfo *hi, uint32_t x); void Pl_Hash_Incr_Int64(HashIncrInfo *hi, uint64_t x); void Pl_Hash_Incr_Double(HashIncrInfo *hi, double x); uint32_t Pl_Hash_Incr_Term(HashIncrInfo *hi); #endif ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/hash_fct1.c��������������������������������������������������������������0000644�0001750�0001750�00000007460�13021324543�015622� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : hash_fct1.c * * Descr.: hash function (part) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /* * This one is mainly MurmurHash3_x86_32 without the finalization part. * * NB: the memory alignment of the key should not affect the hash result. * So it is NOT possible to "consume" 1,2 or 3 bytes at start to ensure * next block reads are aligned. * * This file is included twice to generate 2 versions (aligned and unaligned) */ static uint32_t HASH_BUFFER_FCT(const void *key, int len, uint32_t seed) { uint8_t *data = (uint8_t *) key; const uint8_t *limit_block = data + len - 4; /* -4 for 32-bit block processing */ const uint32_t c1 = 0xcc9e2d51; const uint32_t c2 = 0x1b873593; uint32_t h1 = seed; uint32_t k1; /* body */ while(data <= limit_block) { #ifdef USE_32BITS_ALIGNMENT memcpy(&k1, data, 4); #else k1 = *(uint32_t *) data; #endif data += 4; h1 = Hash_Block(k1, h1); } /* tail */ k1 = 0; switch (len & 3) { case 3: k1 ^= data[2] << 16; case 2: k1 ^= data[1] << 8; case 1: k1 ^= data[0]; k1 *= c1; k1 = ROTL32(k1, 15); k1 *= c2; h1 ^= k1; } return h1; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/wam_inst.h���������������������������������������������������������������0000644�0001750�0001750�00000035722�13021324543�015612� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : wam_inst.h * * Descr.: WAM instruction implementation - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #if 0 #define GARBAGE_COLLECTOR #endif /*---------------------------------* * Constants * *---------------------------------*/ #define NOT_A_WAM_WORD Tag_REF(0) #define NIL_WORD Tag_ATM(ATOM_NIL) /* Read/Write Modes */ /* if S==NULL iff we are in the write mode */ #define WRITE_MODE NULL /* Environment Frame */ #ifdef GARBAGE_COLLECTOR #define ENVIR_STATIC_SIZE 4 #define CPE(e) (*(WamCont *) &(e[-1])) #define BCIE(e) (*(WamWord *) &(e[-2])) #define EE(e) (*(WamWord **) &(e[-3])) #define NBYE(e) (*(WamWord *) &(e[-4])) #define Y(e, y) (*(WamWord *) &(e[-5 - (y)])) #define ENVIR_NAMES {"CPE", "BCIE", "EE", "NBYE"} #else #define ENVIR_STATIC_SIZE 3 #define CPE(e) (*(WamCont *) &(e[-1])) #define BCIE(e) (*(WamWord *) &(e[-2])) #define EE(e) (*(WamWord **) &(e[-3])) #define Y(e, y) (*(WamWord *) &(e[-4 - (y)])) #define ENVIR_NAMES {"CPE", "BCIE", "EE"} #endif /* Choice Point Frame */ #define CHOICE_STATIC_SIZE 8 #define ALTB(b) (*(CodePtr *) &(b[-1])) #define CPB(b) (*(WamCont *) &(b[-2])) #define BCIB(b) (*(WamWord *) &(b[-3])) #define EB(b) (*(WamWord **) &(b[-4])) #define BB(b) (*(WamWord **) &(b[-5])) #define HB(b) (*(WamWord **) &(b[-6])) #define TRB(b) (*(WamWord **) &(b[-7])) #define CSB(b) (*(WamWord **) &(b[-8])) #define AB(b, a) (*(WamWord *) &(b[-9 - (a)])) #define CHOICE_NAMES {"ALTB", "CPB", "BCIB", "EB", "BB", \ "HB", "TRB", "CSB"} /* Wam Objects Manipulation */ /* Trail Tags */ #define NB_OF_TRAIL_TAGS 4 #define TUV 0 /* Trail Unbound Variable */ #define TOV 1 /* Trail One Value */ #define TMV 2 /* Trail Multiple Values */ #define TFC 3 /* Trail for Function Call */ #define TRAIL_TAG_NAMES {"TUV", "TOV", "TMV", "TFC"} #define Trail_Tag_Value(t, v) ((PlULong) (v) | (t)) #define Trail_Tag_Of(w) ((PlULong) (w) & 0x3) #define Trail_Value_Of(w) ((PlULong) (w) & (~0x3)) /* Functor/arity */ #define ATOM_MAX_BITS (sizeof(PlULong) * 8 - 9) #define Functor_Arity(f, n) (((PlULong) (n) << ATOM_MAX_BITS) | (f)) #define Functor_Of(word) ((PlULong)(word) & (((PlULong) 1 << ATOM_MAX_BITS) - 1)) #define Arity_Of(word) ((PlULong) (word) >> ATOM_MAX_BITS) #ifndef NO_USE_FD_SOLVER #define Dont_Separate_Tag(tag_mask) ((tag_mask) == TAG_FDV_MASK) #else #define Dont_Separate_Tag(tag_mask) (0) #endif #define Do_Copy_Of_Word(tag_mask, word) \ if (Dont_Separate_Tag(tag_mask)) \ word = Tag_REF(UnTag_Address(word)) /* Unbound Variables */ #define Make_Self_Ref(adr) (Tag_REF(adr)) /* Atom */ /* Integer */ #define INT_GREATEST_VALUE (((PlLong)1<<(WORD_SIZE-TAG_SIZE-1))-1) #define INT_LOWEST_VALUE ((-INT_GREATEST_VALUE)-1) /* List */ #define OFFSET_CAR 0 #define Car(adr) (((WamWord *) adr)[OFFSET_CAR]) #define Cdr(adr) (((WamWord *) adr)[OFFSET_CAR+1]) /* Structure */ #define OFFSET_ARG 1 #define Functor(adr) (Functor_Of(Functor_And_Arity(adr))) #define Arity(adr) (Arity_Of(Functor_And_Arity(adr))) #define Functor_And_Arity(adr) (((WamWord *) (adr))[0]) #define Arg(adr, i) (((WamWord *) (adr))[OFFSET_ARG+i]) /* i in 0..arity-1 */ /* Stacks */ #define Global_Push(word) (*H++ = (WamWord) (word)) #define Global_Pop (*--H) #define Trail_Push(word) (*TR++ = (WamWord) (word)) #define Trail_Pop (*--TR) #define Is_A_Local_Adr(adr) ((adr) >= LSSA) /* Cut Management */ #define From_B_To_WamWord(b) (Tag_INT((b) - LSSA)) #define From_WamWord_To_B(word) (LSSA + UnTag_INT(word)) /* CP management */ #if defined(M_sparc) || defined(M_sparc64) #define Adjust_CP(cp) ((WamCont) ((PlULong) (cp) - 8)) #define UnAdjust_CP(cp) ((WamCont) ((PlULong) (cp) + 8)) #else #define Adjust_CP(p) ((WamCont) (p)) #define UnAdjust_CP(cp) (cp) #endif #ifndef FRAMES_ONLY /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct /* Switch item information */ { /* ------------------------------- */ PlLong key; /* key: atm, int (if no_opt), f/n */ CodePtr codep; /* compiled code pointer if static */ } SwtInf; typedef SwtInf *SwtTbl; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ WamWord FC Pl_Create_Functor_Arity_Tagged(char *func_str, int arity); SwtTbl FC Pl_Create_Swt_Table(int size); void FC Pl_Create_Swt_Atm_Element(SwtTbl t, int size, int atom, CodePtr codep); void FC Pl_Create_Swt_Stc_Element(SwtTbl t, int size, int func, int arity, CodePtr codep); Bool FC Pl_Get_Atom_Tagged(WamWord w, WamWord start_word); Bool FC Pl_Get_Atom(int atom, WamWord start_word); Bool FC Pl_Get_Integer_Tagged(WamWord w, WamWord start_word); Bool FC Pl_Get_Integer(PlLong n, WamWord start_word); Bool FC Pl_Get_Float(double n, WamWord start_word); Bool FC Pl_Get_Nil(WamWord start_word); Bool FC Pl_Get_List(WamWord start_word); Bool FC Pl_Get_Structure_Tagged(WamWord w, WamWord start_word); Bool FC Pl_Get_Structure(int func, int arity, WamWord start_word); WamWord FC Pl_Put_X_Variable(void); WamWord FC Pl_Put_Y_Variable(WamWord *y_adr); WamWord FC Pl_Put_Unsafe_Value(WamWord start_word); WamWord FC Pl_Put_Atom_Tagged(WamWord w); WamWord FC Pl_Put_Atom(int atom); WamWord FC Pl_Put_Integer_Tagged(WamWord w); WamWord FC Pl_Put_Integer(PlLong n); WamWord FC Pl_Put_Float(double n); WamWord FC Pl_Put_Nil(void); WamWord FC Pl_Put_List(void); WamWord FC Pl_Put_Structure_Tagged(WamWord w); WamWord FC Pl_Put_Structure(int func, int arity); WamWord FC Pl_Put_Meta_Term_Tagged(WamWord module_word, WamWord goal_word); WamWord FC Pl_Put_Meta_Term(int module, WamWord goal_word); WamWord FC Pl_Unify_Variable(void); void FC Pl_Unify_Void(int n); Bool FC Pl_Unify_Value(WamWord start_word); Bool FC Pl_Unify_Local_Value(WamWord start_word); Bool FC Pl_Unify_Atom_Tagged(WamWord w); Bool FC Pl_Unify_Atom(int atom); Bool FC Pl_Unify_Integer_Tagged(WamWord w); Bool FC Pl_Unify_Integer(PlLong n); Bool FC Pl_Unify_Nil(void); Bool FC Pl_Unify_List(void); Bool FC Pl_Unify_Structure_Tagged(WamWord w); Bool FC Pl_Unify_Structure(int func, int arity); WamWord FC Pl_Globalize_If_In_Local(WamWord start_word); void FC Pl_Allocate(int n); void FC Pl_Deallocate(void); CodePtr FC Pl_Switch_On_Term(CodePtr c_var, CodePtr c_atm, CodePtr c_int, CodePtr c_lst, CodePtr c_stc); CodePtr FC Pl_Switch_On_Term_Var_Atm(CodePtr c_var, CodePtr c_atm); CodePtr FC Pl_Switch_On_Term_Var_Stc(CodePtr c_var, CodePtr c_stc); CodePtr FC Pl_Switch_On_Term_Var_Atm_Lst(CodePtr c_var, CodePtr c_atm, CodePtr c_lst); CodePtr FC Pl_Switch_On_Term_Var_Atm_Stc(CodePtr c_var, CodePtr c_atm, CodePtr c_stc); CodePtr FC Pl_Switch_On_Atom(SwtTbl t, int size); PlLong FC Pl_Switch_On_Integer(void); CodePtr FC Pl_Switch_On_Structure(SwtTbl t, int size); WamWord FC Pl_Get_Current_Choice(void); void FC Pl_Cut(WamWord b_word); void FC Pl_Soft_Cut(WamWord b_word); void FC Pl_Global_Push_Float(double n); double FC Pl_Obtain_Float(WamWord *adr); void FC Pl_Create_Choice_Point(CodePtr codep_alt, int arity); void FC Pl_Create_Choice_Point0(CodePtr codep_alt); void FC Pl_Create_Choice_Point1(CodePtr codep_alt); void FC Pl_Create_Choice_Point2(CodePtr codep_alt); void FC Pl_Create_Choice_Point3(CodePtr codep_alt); void FC Pl_Create_Choice_Point4(CodePtr codep_alt); void FC Pl_Update_Choice_Point(CodePtr codep_alt, int arity); void FC Pl_Update_Choice_Point0(CodePtr codep_alt); void FC Pl_Update_Choice_Point1(CodePtr codep_alt); void FC Pl_Update_Choice_Point2(CodePtr codep_alt); void FC Pl_Update_Choice_Point3(CodePtr codep_alt); void FC Pl_Update_Choice_Point4(CodePtr codep_alt); void FC Pl_Delete_Choice_Point(int arity); void FC Pl_Delete_Choice_Point0(void); void FC Pl_Delete_Choice_Point1(void); void FC Pl_Delete_Choice_Point2(void); void FC Pl_Delete_Choice_Point3(void); void FC Pl_Delete_Choice_Point4(void); void Pl_Defeasible_Open(); void Pl_Defeasible_Undo(); void Pl_Defeasible_Close(Bool undo_before); void FC Pl_Untrail(WamWord *low_adr); Bool FC Pl_Unify(WamWord start_u_word, WamWord start_v_word); Bool FC Pl_Unify_Occurs_Check(WamWord start_u_word, WamWord start_v_word); #endif /* FRAME_ONLY */ /*---------------------------------* * Auxiliary engine macros * *---------------------------------*/ /*---------------------------------------------------------------* * DEREF dereferences the word start_word and sets : * * word : dereferenced word * * tag_mask: dereferenced word's tag mask * *---------------------------------------------------------------*/ #if 0 #define DEREF_STATS #endif #ifdef DEREF_STATS PlLong nb_deref; PlLong chain_len; #define DEREF_COUNT(x) x++ #else #define DEREF_COUNT(x) #endif #define DEREF(start_word, word, tag_mask) \ do \ { \ WamWord deref_last_word; \ \ word = start_word; \ \ DEREF_COUNT(nb_deref); \ do \ { \ DEREF_COUNT(chain_len); \ deref_last_word = word; \ tag_mask = Tag_Mask_Of(word); \ if (tag_mask != TAG_REF_MASK) \ break; \ word = *(UnTag_REF(word)); \ } \ while (word != deref_last_word); \ } \ while (0) /* Trail Stack Management */ #define Word_Needs_Trailing(adr) \ ((adr) < HB1 || (Is_A_Local_Adr(adr) && (adr) < B)) #define Bind_UV(adr, word) \ do \ { \ if (Word_Needs_Trailing(adr)) \ Trail_UV(adr); \ *(adr) = (word); \ } \ while (0) #define Bind_OV(adr, word) \ do \ { \ if (Word_Needs_Trailing(adr)) \ Trail_OV(adr); \ *(adr) = (word); \ } \ while (0) #define Bind_MV(adr, nb, real_adr) \ do \ { \ if (Word_Needs_Trailing(adr)) \ Trail_MV(adr, nb); \ Mem_Word_Cpy(adr, real_adr, nb); \ } \ while (0) #define Trail_UV(adr) \ Trail_Push(Trail_Tag_Value(TUV, adr)) #define Trail_OV(adr) \ do \ { \ Trail_Push(*(adr)); \ Trail_Push(Trail_Tag_Value(TOV, adr)); \ } \ while (0) #define Trail_MV(adr, nb) \ do \ { \ Mem_Word_Cpy(TR, adr, nb); \ TR += nb; \ Trail_Push(nb); \ Trail_Push(Trail_Tag_Value(TMV, adr)); \ } \ while (0) #define Trail_FC(fct, nb, arg) \ do \ { \ Mem_Word_Cpy(TR, arg, nb); \ TR += nb; \ Trail_Push(nb); \ Trail_Push(fct); /*fct adr not aligned*/ \ Trail_Push(Trail_Tag_Value(TFC, 0)); \ } \ while (0) #define Assign_B(newB) (B = (newB), HB1 = HB(B)) #define Delete_Last_Choice_Point() Assign_B(BB(B)) /* Globalization */ #define Globalize_Local_Unbound_Var(adr, res_word) \ do \ { \ WamWord *cur_H = H; \ \ res_word = Make_Self_Ref(cur_H); \ *cur_H = res_word; \ H++; \ Bind_UV(adr, res_word); \ } \ while (0) #define Mem_Word_Cpy(dst, src, nb) \ do \ { \ register PlLong *s = (PlLong *) (src); \ register PlLong *d = (PlLong *) (dst); \ register int counter = (nb); \ \ do \ *d++ = *s++; \ while (--counter); \ } \ while (0) ����������������������������������������������gprolog-1.4.5/src/EnginePl/if_no_fd.c���������������������������������������������������������������0000644�0001750�0001750�00000012020�13021324543�015511� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : if_no_fd.c * * Descr.: FD interface for Prolog engine * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #define IF_NO_FD_FILE #include "engine_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /* Errors Messages */ #define ERR_FD_SOLVER_MISSING __FILE__ ": FD Solver not linked" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Fd_Solver_Missing(void); /*-------------------------------------------------------------------------* * PL_FD_INIT_SOLVER * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Init_Solver(void) { if (pl_fd_init_solver == NULL) /* FD solver not linked */ { pl_fd_unify_with_integer = (Bool (*)()) Fd_Solver_Missing; pl_fd_unify_with_fd_var = (Bool (*)()) Fd_Solver_Missing; pl_fd_variable_size = (int (*)()) Fd_Solver_Missing; pl_fd_copy_variable = (int (*)()) Fd_Solver_Missing; pl_fd_variable_to_string = (char *(*)()) Fd_Solver_Missing; return; } (*pl_fd_init_solver) (); } /*-------------------------------------------------------------------------* * PL_FD_RESET_SOLVER * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Reset_Solver(void) { void (*copy_of_pl_fd_reset_solver) () = Pl_Dummy_Ptr(pl_fd_reset_solver); if (copy_of_pl_fd_reset_solver == NULL) /* FD solver not linked */ return; (*copy_of_pl_fd_reset_solver) (); } /*-------------------------------------------------------------------------* * FD_SOLVER_MISSING * * * *-------------------------------------------------------------------------*/ void Fd_Solver_Missing(void) { Pl_Fatal_Error(ERR_FD_SOLVER_MISSING); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/unify.c������������������������������������������������������������������0000644�0001750�0001750�00000016075�13021324543�015116� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : unify.c * * Descr.: unification part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ static Bool Check_If_Var_Occurs(WamWord *var_adr, WamWord term_word); /*-------------------------------------------------------------------------* * This file is not compiled separately but included twice by wam_inst.c: * * - to define the Unify function (classical unification). * * - to define the Unify_Occurs_Check function (+ occurs check). * *-------------------------------------------------------------------------*/ Bool FC UNIFY_FCT_NAME(WamWord start_u_word, WamWord start_v_word) { WamWord u_word, u_tag_mask; WamWord v_word, v_tag_mask; WamWord *u_adr, *v_adr; int i; terminal_rec: DEREF(start_u_word, u_word, u_tag_mask); DEREF(start_v_word, v_word, v_tag_mask); if (u_tag_mask == TAG_REF_MASK) { u_adr = UnTag_REF(u_word); if (v_tag_mask == TAG_REF_MASK) { v_adr = UnTag_REF(v_word); if (u_adr > v_adr) Bind_UV(u_adr, Tag_REF(v_adr)); else if (v_adr > u_adr) Bind_UV(v_adr, Tag_REF(u_adr)); } else { #ifdef OCCURS_CHECK if (!Is_A_Local_Adr(u_adr) && /* no binding from heap to local */ Check_If_Var_Occurs(u_adr, v_word)) return FALSE; #endif Do_Copy_Of_Word(v_tag_mask, v_word); Bind_UV(u_adr, v_word); } return TRUE; } if (v_tag_mask == TAG_REF_MASK) { v_adr = UnTag_REF(v_word); #ifdef OCCURS_CHECK if (!Is_A_Local_Adr(v_adr) && /* no binding from heap to local */ Check_If_Var_Occurs(v_adr, u_word)) return FALSE; #endif Do_Copy_Of_Word(u_tag_mask, u_word); Bind_UV(v_adr, u_word); return TRUE; } if (u_word == v_word) return TRUE; if (v_tag_mask == TAG_LST_MASK) { if (u_tag_mask != v_tag_mask) return FALSE; u_adr = UnTag_LST(u_word); v_adr = UnTag_LST(v_word); u_adr = &Car(u_adr); v_adr = &Car(v_adr); if (!UNIFY_FCT_NAME(*u_adr++, *v_adr++)) return FALSE; start_u_word = *u_adr; start_v_word = *v_adr; goto terminal_rec; } if (v_tag_mask == TAG_STC_MASK) { if (u_tag_mask != v_tag_mask) return FALSE; u_adr = UnTag_STC(u_word); v_adr = UnTag_STC(v_word); if (Functor_And_Arity(u_adr) != Functor_And_Arity(v_adr)) return FALSE; i = Arity(u_adr); u_adr = &Arg(u_adr, 0); v_adr = &Arg(v_adr, 0); while (--i) if (!UNIFY_FCT_NAME(*u_adr++, *v_adr++)) return FALSE; start_u_word = *u_adr; start_v_word = *v_adr; goto terminal_rec; } #ifndef NO_USE_FD_SOLVER if (v_tag_mask == TAG_INT_MASK && u_tag_mask == TAG_FDV_MASK) return Fd_Unify_With_Integer(UnTag_FDV(u_word), UnTag_INT(v_word)); if (v_tag_mask == TAG_FDV_MASK) { v_adr = UnTag_FDV(v_word); if (u_tag_mask == TAG_INT_MASK) return Fd_Unify_With_Integer(v_adr, UnTag_INT(u_word)); if (u_tag_mask != v_tag_mask) /* i.e. TAG_FDV_MASK */ return FALSE; return Fd_Unify_With_Fd_Var(UnTag_FDV(u_word), v_adr); } #endif if (v_tag_mask == TAG_FLT_MASK) return (u_tag_mask == v_tag_mask && Pl_Obtain_Float(UnTag_FLT(u_word)) == Pl_Obtain_Float(UnTag_FLT(v_word))); return FALSE; } #ifdef OCCURS_CHECK /*-------------------------------------------------------------------------* * CHECK_IF_VAR_OCCURS * * * * Only called if var_adr resides in the heap since a var residing in the * * local stack cannot appear in a term (there is no binding from the heap * * to the local stack in the WAM). * *-------------------------------------------------------------------------*/ static Bool Check_If_Var_Occurs(WamWord *var_adr, WamWord term_word) { WamWord word, tag_mask; WamWord *adr; int i; terminal_rec: DEREF(term_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) return UnTag_REF(word) == var_adr; if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); adr = &Car(adr); if (Check_If_Var_Occurs(var_adr, *adr++)) return TRUE; term_word = *adr; goto terminal_rec; } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); i = Arity(adr); adr = &Arg(adr, 0); while (--i) if (Check_If_Var_Occurs(var_adr, *adr++)) return TRUE; term_word = *adr; goto terminal_rec; } return FALSE; } #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/wam_inst.c���������������������������������������������������������������0000644�0001750�0001750�00000133537�13021324543�015610� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : wam_inst.c * * Descr.: WAM instruction implementation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include "engine_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef union { double d; WamWord i[2]; } DblInt; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static SwtInf *Locate_Swt_Element(SwtTbl t, int size, PlLong key); /*-------------------------------------------------------------------------* * PL_CREATE_FUNCTOR_ARITY_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Create_Functor_Arity_Tagged(char *func_str, int arity) { int func = Pl_Create_Atom(func_str); return Functor_Arity(func, arity); } /*-------------------------------------------------------------------------* * PL_CREATE_SWT_TABLE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ SwtTbl FC Pl_Create_Swt_Table(int size) { SwtTbl t; size++; /* +1 to ensure that one free cell exists */ t = (SwtTbl) Calloc(size, sizeof(SwtInf)); return t; } /*-------------------------------------------------------------------------* * PL_CREATE_SWT_ATM_ELEMENT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Create_Swt_Atm_Element(SwtTbl t, int size, int atom, CodePtr codep) { SwtInf *swt = Locate_Swt_Element(t, size, atom); swt->key = atom; swt->codep = codep; } /*-------------------------------------------------------------------------* * PL_CREATE_SWT_STC_ELEMENT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Create_Swt_Stc_Element(SwtTbl t, int size, int func, int arity, CodePtr codep) { PlLong key = Functor_Arity(func, arity); SwtInf *swt = Locate_Swt_Element(t, size, key); swt->key = key; swt->codep = codep; } /*-------------------------------------------------------------------------* * LOCATE_SWT_ELEMENT * * * *-------------------------------------------------------------------------*/ static SwtInf * Locate_Swt_Element(SwtTbl t, int size, PlLong key) { int n; SwtInf *swt, *endt; size++; /* +1 to ensure that one free cell exists */ #if 1 n = key % size; #else n = (key ^ ((PlULong) key >> 16)) % size; #endif /* here either the key is in the table */ /* or there is at least one free cell. */ swt = t + n; endt = t + size; while (swt->codep && swt->key != key) { swt++; if (swt == endt) swt = t; } return swt; } /*-------------------------------------------------------------------------* * PL_GET_ATOM_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Atom_Tagged(WamWord w, WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), w); return TRUE; } return (word == w); } /*-------------------------------------------------------------------------* * PL_GET_ATOM * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Atom(int atom, WamWord start_word) { return Pl_Get_Atom_Tagged(Tag_ATM(atom), start_word); } /*-------------------------------------------------------------------------* * PL_GET_INTEGER_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Integer_Tagged(WamWord w, WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), w); return TRUE; } #ifndef NO_USE_FD_SOLVER if (tag_mask == TAG_FDV_MASK) return Fd_Unify_With_Integer(UnTag_FDV(word), UnTag_INT(w)); #endif return (word == w); } /*-------------------------------------------------------------------------* * PL_GET_INTEGER * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Integer(PlLong n, WamWord start_word) { return Pl_Get_Integer_Tagged(Tag_INT(n), start_word); } /*-------------------------------------------------------------------------* * PL_GET_FLOAT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Float(double n, WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), Tag_FLT(H)); Pl_Global_Push_Float(n); return TRUE; } return (tag_mask == TAG_FLT_MASK && Pl_Obtain_Float(UnTag_FLT(word)) == n); } /*-------------------------------------------------------------------------* * PL_GET_NIL * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Nil(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), NIL_WORD); return TRUE; } return (word == NIL_WORD); } /*-------------------------------------------------------------------------* * PL_GET_LIST * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_List(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), Tag_LST(H)); S = WRITE_MODE; return TRUE; } if (tag_mask == TAG_LST_MASK) { S = UnTag_LST(word) + OFFSET_CAR; return TRUE; } return FALSE; } /*-------------------------------------------------------------------------* * PL_GET_STRUCTURE_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Structure_Tagged(WamWord w, WamWord start_word) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { WamWord *cur_H = H; *cur_H = w; H++; S = WRITE_MODE; Bind_UV(UnTag_REF(word), Tag_STC(cur_H)); return TRUE; } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); if (Functor_And_Arity(adr) != w) return FALSE; S = adr + OFFSET_ARG; return TRUE; } return FALSE; } /*-------------------------------------------------------------------------* * PL_GET_STRUCTURE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Get_Structure(int func, int arity, WamWord start_word) { return Pl_Get_Structure_Tagged(Functor_Arity(func, arity), start_word); } /*-------------------------------------------------------------------------* * PL_PUT_X_VARIABLE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_X_Variable(void) { WamWord res_word; WamWord *cur_H = H; res_word = Make_Self_Ref(cur_H); *cur_H = res_word; H++; return res_word; } /*-------------------------------------------------------------------------* * PL_PUT_Y_VARIABLE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Y_Variable(WamWord *y_adr) { return *y_adr = Make_Self_Ref(y_adr); } /*-------------------------------------------------------------------------* * PL_PUT_UNSAFE_VALUE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Unsafe_Value(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; WamWord res_word; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK && (adr = UnTag_REF(word)) >= (WamWord *) EE(E)) { Globalize_Local_Unbound_Var(adr, res_word); return res_word; } Do_Copy_Of_Word(tag_mask, word); return word; } /*-------------------------------------------------------------------------* * PL_PUT_ATOM_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Atom_Tagged(WamWord w) { return w; } /*-------------------------------------------------------------------------* * PL_PUT_ATOM * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Atom(int atom) { return Tag_ATM(atom); } /*-------------------------------------------------------------------------* * PL_PUT_INTEGER_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Integer_Tagged(WamWord w) { return w; } /*-------------------------------------------------------------------------* * PL_PUT_INTEGER * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Integer(PlLong n) { return Tag_INT(n); } /*-------------------------------------------------------------------------* * PL_PUT_FLOAT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Float(double n) { WamWord res_word; res_word = Tag_FLT(H); Pl_Global_Push_Float(n); return res_word; } /*-------------------------------------------------------------------------* * PL_PUT_NIL * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Nil(void) { return NIL_WORD; } /*-------------------------------------------------------------------------* * PL_PUT_LIST * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_List(void) { S = WRITE_MODE; return Tag_LST(H); } /*-------------------------------------------------------------------------* * PL_PUT_STRUCTURE_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Structure_Tagged(WamWord w) { WamWord *cur_H = H; *cur_H = w; H++; S = WRITE_MODE; return Tag_STC(cur_H); } /*-------------------------------------------------------------------------* * PL_PUT_STRUCTURE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Structure(int func, int arity) { return Pl_Put_Structure_Tagged(Functor_Arity(func, arity)); } /*-------------------------------------------------------------------------* * PL_PUT_META_TERM_TAGGED * * * * Called by compiled prolog code. * * * * See also Pl_Get_Module_And_Goal (for meta_term decomposition) * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Meta_Term_Tagged(WamWord module_word, WamWord goal_word) { WamWord *cur_H = H; WamWord res_word; #ifdef META_TERM_HIDDEN int offset; #endif /* Avoid to create meta_term on an existing SAME meta_term. * SAME is because we want to have the calling context, e.g. * if goal_word is foo:p(...) and the module is bar we will * obtain bar:foo:p(...) (so the topmost module is the caller module) * But if goal_word is bar:p(...) the goal remains unchanged * See Pl_Set_Calling_Module (and fct like Pl_Strip_Module_Top) */ #if 1 WamWord word, tag_mask; WamWord f_n; WamWord *adr; DEREF(goal_word, word, tag_mask); if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); f_n = Functor_And_Arity(adr); if (f_n == Functor_Arity(ATOM_CHAR(':'), 2)) { DEREF(module_word, word, tag_mask); module_word = word; DEREF(Arg(adr, 0), word, tag_mask); /* module part */ if (word == module_word) return goal_word; } #ifdef META_TERM_HIDDEN if (f_n == Functor_Arity(pl_atom_meta_term, 1)) /* also test arg1 = offset ? */ return goal_word; #endif } #endif res_word = Tag_STC(cur_H); #ifdef META_TERM_HIDDEN /* Return a term '$$meta_term'(Offset) in A(j) * Offset is an index in the heap. * In the heap Offset is followed by Module, Goal as for * '$$meta_term'(Offset, Module, Goal) (only the F/N word contains N=1) * NB: GC (and copy_term ?) has then to treat '$$meta_term'/1 as '$$meta_term'/3. * NB: the Offset argument is then useless (can be used to check validity). */ offset = cur_H - Global_Stack; *cur_H++ = Functor_Arity(pl_atom_meta_term, 1); *cur_H++ = Tag_INT(offset); *cur_H++ = module_word; *cur_H++ = goal_word; #else /* Return a meta-term of the form Module:Goal in A(j) */ *cur_H++ = Functor_Arity(ATOM_CHAR(':'), 2); *cur_H++ = module_word; *cur_H++ = goal_word; #endif H = cur_H; return res_word; } /*-------------------------------------------------------------------------* * PL_PUT_META_TERM * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Put_Meta_Term(int module, WamWord goal_word) { return Pl_Put_Meta_Term_Tagged(Tag_ATM(module), goal_word); } /*-------------------------------------------------------------------------* * PL_UNIFY_VARIABLE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Unify_Variable(void) { WamWord tag_mask, word; WamWord res_word; WamWord *cur_H; if (S != WRITE_MODE) { word = *S++; tag_mask = Tag_Mask_Of(word); Do_Copy_Of_Word(tag_mask, word); return word; } cur_H = H; res_word = Make_Self_Ref(cur_H); *cur_H = res_word; H++; return res_word; } /*-------------------------------------------------------------------------* * PL_UNIFY_VOID * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Unify_Void(int n) { WamWord *cur_H; if (S != WRITE_MODE) { S += n; return; } cur_H = H; H += n; do { *cur_H = Make_Self_Ref(cur_H); cur_H++; } while(--n > 0); } /*-------------------------------------------------------------------------* * PL_UNIFY_VALUE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Value(WamWord start_word) { if (S != WRITE_MODE) return Pl_Unify(start_word, *S++); Global_Push(start_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_LOCAL_VALUE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Local_Value(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; if (S != WRITE_MODE) return Pl_Unify(start_word, *S++); DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK && Is_A_Local_Adr(adr = UnTag_REF(word))) Globalize_Local_Unbound_Var(adr, word); else { Do_Copy_Of_Word(tag_mask, word); Global_Push(word); } return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_ATOM_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Atom_Tagged(WamWord w) { WamWord word, tag_mask; if (S != WRITE_MODE) { DEREF(*S, word, tag_mask); S++; if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), w); return TRUE; } return (word == w); } Global_Push(w); return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_ATOM * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Atom(int atom) { return Pl_Unify_Atom_Tagged(Tag_ATM(atom)); } /*-------------------------------------------------------------------------* * PL_UNIFY_INTEGER_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Integer_Tagged(WamWord w) { WamWord word, tag_mask; if (S != WRITE_MODE) { DEREF(*S, word, tag_mask); S++; if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), w); return TRUE; } #ifndef NO_USE_FD_SOLVER if (tag_mask == TAG_FDV_MASK) return Fd_Unify_With_Integer(UnTag_FDV(word), UnTag_INT(w)); #endif return (word == w); } Global_Push(w); return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_INTEGER * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Integer(PlLong n) { return Pl_Unify_Integer_Tagged(Tag_INT(n)); } /*-------------------------------------------------------------------------* * PL_UNIFY_NIL * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Nil(void) { WamWord word, tag_mask; if (S != WRITE_MODE) { DEREF(*S, word, tag_mask); S++; if (tag_mask == TAG_REF_MASK) { Bind_UV(UnTag_REF(word), NIL_WORD); return TRUE; } return (word == NIL_WORD); } Global_Push(NIL_WORD); return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_LIST * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_List(void) { WamWord *cur_H; if (S != WRITE_MODE) return Pl_Get_List(*S); cur_H = H; *cur_H = Tag_LST(cur_H + 1); H++; return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_STRUCTURE_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Structure_Tagged(WamWord w) { WamWord *cur_H; if (S != WRITE_MODE) return Pl_Get_Structure_Tagged(w, *S); cur_H = H; *cur_H = Tag_STC(cur_H + 1); cur_H[1] = w; H += 2; return TRUE; } /*-------------------------------------------------------------------------* * PL_UNIFY_STRUCTURE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ Bool FC Pl_Unify_Structure(int func, int arity) { return Pl_Unify_Structure_Tagged(Functor_Arity(func, arity)); } /*-------------------------------------------------------------------------* * PL_GLOBALIZE_IF_IN_LOCAL * * * *-------------------------------------------------------------------------*/ WamWord FC Pl_Globalize_If_In_Local(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { adr = UnTag_REF(word); if (Is_A_Local_Adr(adr)) Globalize_Local_Unbound_Var(adr, start_word); } return start_word; } /*-------------------------------------------------------------------------* * PL_ALLOCATE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Allocate(int n) { WamWord *old_E = E; WamWord *cur_E = Local_Top + ENVIR_STATIC_SIZE + n; E = cur_E; CPE(cur_E) = (WamCont) CP; BCIE(cur_E) = BCI; EE(cur_E) = (WamWord *) old_E; #ifdef GARBAGE_COLLECTOR NBYE(cur_E) = n; cur_E = &Y(cur_E, 0); while(n-- > 0) { *cur_E = Make_Self_Ref(cur_E); cur_E--; } #endif } /*-------------------------------------------------------------------------* * PL_DEALLOCATE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Deallocate(void) { WamWord *cur_E = E; CP = CPE(cur_E); BCI = BCIE(cur_E); E = EE(cur_E); } /*-------------------------------------------------------------------------* * SWITCH_ON_TERM and specialized versions * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ CodePtr FC Pl_Switch_On_Term(CodePtr c_var, CodePtr c_atm, CodePtr c_int, CodePtr c_lst, CodePtr c_stc) { WamWord word, tag_mask; CodePtr codep; DEREF(A(0), word, tag_mask); A(0) = word; if (tag_mask == TAG_INT_MASK) codep = c_int; else if (tag_mask == TAG_ATM_MASK) codep = c_atm; else if (tag_mask == TAG_LST_MASK) codep = c_lst; else if (tag_mask == TAG_STC_MASK) codep = c_stc; else /* REF or FDV */ codep = c_var; return (codep) ? codep : ALTB(B); } CodePtr FC Pl_Switch_On_Term_Var_Atm(CodePtr c_var, CodePtr c_atm) { WamWord word, tag_mask; DEREF(A(0), word, tag_mask); A(0) = word; if (tag_mask == TAG_ATM_MASK) return c_atm; if (tag_mask == TAG_REF_MASK #ifndef NO_USE_FD_SOLVER || tag_mask == TAG_FDV_MASK #endif ) return c_var; return ALTB(B); } CodePtr FC Pl_Switch_On_Term_Var_Stc(CodePtr c_var, CodePtr c_stc) { WamWord word, tag_mask; DEREF(A(0), word, tag_mask); A(0) = word; if (tag_mask == TAG_STC_MASK) return c_stc; if (tag_mask == TAG_REF_MASK #ifndef NO_USE_FD_SOLVER || tag_mask == TAG_FDV_MASK #endif ) return c_var; return ALTB(B); } CodePtr FC Pl_Switch_On_Term_Var_Atm_Lst(CodePtr c_var, CodePtr c_atm, CodePtr c_lst) { WamWord word, tag_mask; DEREF(A(0), word, tag_mask); A(0) = word; if (tag_mask == TAG_LST_MASK) return c_lst; if (tag_mask == TAG_ATM_MASK) return c_atm; if (tag_mask == TAG_REF_MASK #ifndef NO_USE_FD_SOLVER || tag_mask == TAG_FDV_MASK #endif ) return c_var; return ALTB(B); } CodePtr FC Pl_Switch_On_Term_Var_Atm_Stc(CodePtr c_var, CodePtr c_atm, CodePtr c_stc) { WamWord word, tag_mask; DEREF(A(0), word, tag_mask); A(0) = word; if (tag_mask == TAG_STC_MASK) return c_stc; if (tag_mask == TAG_ATM_MASK) return c_atm; if (tag_mask == TAG_REF_MASK #ifndef NO_USE_FD_SOLVER || tag_mask == TAG_FDV_MASK #endif ) return c_var; return ALTB(B); } /*-------------------------------------------------------------------------* * PL_SWITCH_ON_ATOM * * * * switch_on_atom always occurs after a switch_on_term, thus A(0) is * * dereferenced and has been updated with its deref word. * * Look in the hash table t and return the adr of the corresponding code. * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ CodePtr FC Pl_Switch_On_Atom(SwtTbl t, int size) { SwtInf *swt; swt = Locate_Swt_Element(t, size, (PlLong) UnTag_ATM(A(0))); return (swt->codep) ? swt->codep : ALTB(B); } /*-------------------------------------------------------------------------* * PL_SWITCH_ON_INTEGER * * * * switch_on_integer always occurs after a switch_on_term, thus A(0) is * * dereferenced and has been updated with its deref word. * * Simply return the integer since the switch is done by the assembly code.* * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ PlLong FC Pl_Switch_On_Integer(void) { return UnTag_INT(A(0)); } /*-------------------------------------------------------------------------* * PL_SWITCH_ON_STRUCTURE * * * * switch_on_structure always occurs after a switch_on_term, thus A(0) is * * dereferenced and has been updated with its deref word. * * Look in the hash table t and return the adr of the corresponding code. * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ CodePtr FC Pl_Switch_On_Structure(SwtTbl t, int size) { SwtInf *swt; swt = Locate_Swt_Element(t, size, Functor_And_Arity(UnTag_STC(A(0)))); return (swt->codep) ? swt->codep : ALTB(B); } /*-------------------------------------------------------------------------* * PL_GET_CURRENT_CHOICE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Get_Current_Choice(void) { return From_B_To_WamWord(B); } /*-------------------------------------------------------------------------* * PL_CUT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Cut(WamWord b_word) { Assign_B(From_WamWord_To_B(b_word)); } /*-------------------------------------------------------------------------* * PL_SOFT_CUT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Soft_Cut(WamWord b_word) { WamWord *kill_B = From_WamWord_To_B(b_word); WamWord *cur_B = B; WamWord *prev_B; /* soft cut: unchain the choice-point pointed by kill_B */ if (cur_B == kill_B) { Assign_B(BB(cur_B)); return; } for(;;) { prev_B = BB(cur_B); if (prev_B == kill_B) /* found */ { BB(cur_B) = BB(kill_B); break; } if (cur_B < kill_B) /* not found (can occur at backtracking since already unchained) */ break; cur_B = prev_B; } } /* Auxiliary Functions */ /*-------------------------------------------------------------------------* * PL_GLOBAL_PUSH_FLOAT * * * *-------------------------------------------------------------------------*/ void FC Pl_Global_Push_Float(double n) { DblInt di; di.d = n; *H++ = di.i[0]; #if WORD_SIZE == 32 *H++ = di.i[1]; #endif } /*-------------------------------------------------------------------------* * PL_OBTAIN_FLOAT * * * *-------------------------------------------------------------------------*/ double FC Pl_Obtain_Float(WamWord *adr) { DblInt di; di.i[0] = adr[0]; #if WORD_SIZE == 32 di.i[1] = adr[1]; #endif return di.d; } /*-------------------------------------------------------------------------* * CREATE_CHOICE_POINT and specialized versions * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ #define CREATE_CHOICE_COMMON_PART(arity) \ WamWord *old_B = B; \ WamWord *cur_B = Local_Top + CHOICE_STATIC_SIZE + arity; \ \ B = cur_B; \ \ ALTB(cur_B) = codep_alt; \ CPB(cur_B) = CP; \ BCIB(cur_B) = BCI; \ EB(cur_B) = E; \ BB(cur_B) = old_B; \ HB(cur_B) = HB1 = H; \ TRB(cur_B) = TR; \ CSB(cur_B) = CS; \ \ STAMP++ /* common part for update/delete */ /* restore registers except B and HB1 */ #define UPDATE_DELETE_COMMON_PART \ WamWord *cur_B = B; \ \ Pl_Untrail(TRB(cur_B)); \ \ CP = CPB(cur_B); \ BCI = BCIB(cur_B); \ H = HB(cur_B); \ E = EB(cur_B); \ CS = CSB(cur_B) /* update ALTB, restore HB1 */ #define UPDATE_CHOICE_COMMON_PART \ UPDATE_DELETE_COMMON_PART; \ ALTB(cur_B) = codep_alt; \ HB1 = H /* restore B (and HB1), update STAMP */ #define DELETE_CHOICE_COMMON_PART \ UPDATE_DELETE_COMMON_PART; \ Assign_B(BB(cur_B)); \ STAMP-- void FC Pl_Create_Choice_Point(CodePtr codep_alt, int arity) { int i; CREATE_CHOICE_COMMON_PART(arity); for (i = 0; i < arity; i++) AB(cur_B, i) = A(i); } void FC Pl_Create_Choice_Point0(CodePtr codep_alt) { CREATE_CHOICE_COMMON_PART(0); } void FC Pl_Create_Choice_Point1(CodePtr codep_alt) { CREATE_CHOICE_COMMON_PART(1); AB(cur_B, 0) = A(0); } void FC Pl_Create_Choice_Point2(CodePtr codep_alt) { CREATE_CHOICE_COMMON_PART(2); AB(cur_B, 0) = A(0); AB(cur_B, 1) = A(1); } void FC Pl_Create_Choice_Point3(CodePtr codep_alt) { CREATE_CHOICE_COMMON_PART(3); AB(cur_B, 0) = A(0); AB(cur_B, 1) = A(1); AB(cur_B, 2) = A(2); } void FC Pl_Create_Choice_Point4(CodePtr codep_alt) { CREATE_CHOICE_COMMON_PART(4); AB(cur_B, 0) = A(0); AB(cur_B, 1) = A(1); AB(cur_B, 2) = A(2); AB(cur_B, 3) = A(3); } /*-------------------------------------------------------------------------* * UPDATE_CHOICE_POINT and specialized versions * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Update_Choice_Point(CodePtr codep_alt, int arity) { int i; UPDATE_CHOICE_COMMON_PART; for (i = 0; i < arity; i++) A(i) = AB(cur_B, i); } void FC Pl_Update_Choice_Point0(CodePtr codep_alt) { UPDATE_CHOICE_COMMON_PART; } void FC Pl_Update_Choice_Point1(CodePtr codep_alt) { UPDATE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); } void FC Pl_Update_Choice_Point2(CodePtr codep_alt) { UPDATE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); A(1) = AB(cur_B, 1); } void FC Pl_Update_Choice_Point3(CodePtr codep_alt) { UPDATE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); A(1) = AB(cur_B, 1); A(2) = AB(cur_B, 2); } void FC Pl_Update_Choice_Point4(CodePtr codep_alt) { UPDATE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); A(1) = AB(cur_B, 1); A(2) = AB(cur_B, 2); A(3) = AB(cur_B, 3); } /*-------------------------------------------------------------------------* * PL_DELETE_CHOICE_POINT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Delete_Choice_Point(int arity) { int i; DELETE_CHOICE_COMMON_PART; for (i = 0; i < arity; i++) A(i) = AB(cur_B, i); } void FC Pl_Delete_Choice_Point0(void) { DELETE_CHOICE_COMMON_PART; } void FC Pl_Delete_Choice_Point1(void) { DELETE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); } void FC Pl_Delete_Choice_Point2(void) { DELETE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); A(1) = AB(cur_B, 1); } void FC Pl_Delete_Choice_Point3(void) { DELETE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); A(1) = AB(cur_B, 1); A(2) = AB(cur_B, 2); } void FC Pl_Delete_Choice_Point4(void) { DELETE_CHOICE_COMMON_PART; A(0) = AB(cur_B, 0); A(1) = AB(cur_B, 1); A(2) = AB(cur_B, 2); A(3) = AB(cur_B, 3); } /*-------------------------------------------------------------------------* * PL_DEFEASIBLE_OPEN * * * *-------------------------------------------------------------------------*/ void Pl_Defeasible_Open() { Pl_Create_Choice_Point0(NULL); } /*-------------------------------------------------------------------------* * PL_DEFEASIBLE_UNDO * * * *-------------------------------------------------------------------------*/ void Pl_Defeasible_Undo() { Pl_Update_Choice_Point0(NULL); } /*-------------------------------------------------------------------------* * PL_DEFEASIBLE_CLOSE * * * *-------------------------------------------------------------------------*/ void Pl_Defeasible_Close(Bool success) { if (success) Assign_B(BB(B)); /* like a cut */ else Pl_Delete_Choice_Point0(); /* untrail */ } /*-------------------------------------------------------------------------* * PL_UNTRAIL * * * *-------------------------------------------------------------------------*/ void FC Pl_Untrail(WamWord *low_adr) { WamWord word; WamWord *adr; int nb; while (TR > low_adr) { word = Trail_Pop; adr = (WamWord *) (Trail_Value_Of(word)); switch (Trail_Tag_Of(word)) { case TUV: *adr = Make_Self_Ref(adr); break; case TOV: *adr = Trail_Pop; break; case TMV: nb = Trail_Pop; TR -= nb; Mem_Word_Cpy(adr, TR, nb); break; default: /* TFC */ adr = (WamWord *) Trail_Pop; /* fct adr no longer word aligned */ nb = Trail_Pop; TR -= nb; (*((int (*)()) adr)) (nb, TR); } } } /*-------------------------------------------------------------------------* * PL_UNIFY * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ #define UNIFY_FCT_NAME Pl_Unify #include "unify.c" /*-------------------------------------------------------------------------* * PL_UNIFY_OCCURS_CHECK * * * *-------------------------------------------------------------------------*/ #undef UNIFY_FCT_NAME #define UNIFY_FCT_NAME Pl_Unify_Occurs_Check #define OCCURS_CHECK #include "unify.c" �����������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/gp_config.h.in�����������������������������������������������������������0000644�0001750�0001750�00000022721�13021324543�016324� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : configuration * * File : gp_config.h.in * * Descr.: general configuration file (handled by autoconf) - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _GP_CONFIG_H #define _GP_CONFIG_H /* Define if you have inttypes.h */ #undef HAVE_INTTYPES_H /* Define if you have sys/ioctl_compat.h */ #undef HAVE_SYS_IOCTL_COMPAT_H /* Define if you have sys/syginfo.h */ #undef HAVE_SYS_SIGINFO_H /* Define if you have termios.h */ #undef HAVE_TERMIOS_H /* Define if you have termio.h */ #undef HAVE_TERMIO_H /* Define if you have malloc.h */ #undef HAVE_MALLOC_H /* Define if you have endian.h */ #undef HAVE_ENDIAN_H /* Define if you have sys/endian.h */ #undef HAVE_SYS_ENDIAN_H /* Define if you have byteswap.h */ #undef HAVE_BYTESWAP_H /* Define if you have float.h */ #undef HAVE_FLOAT_H /* Define if you have the fgetc function */ #undef HAVE_FGETC /* Define if you have the sigsetjmp function */ #undef HAVE_SIGSETJMP /* Define if you have the asinh function */ #undef HAVE_SINH /* Define if you have the acosh function */ #undef HAVE_ACOSH /* Define if you have the atanh function */ #undef HAVE_ATANH /* Define if you have a working mmap system call */ #undef HAVE_MMAP /* Define if you have a working mprotect system call */ #undef HAVE_MPROTECT /* Define if you have a mallopt function */ #undef HAVE_MALLOPT /* Define if you have a htole32 function */ #undef HAVE_DECL_HTOLE32 /* Define if you have a bswap_32 function */ #undef HAVE_DECL_BSWAP_32 /* Define inline keyword */ #undef inline /* Define if you don't want to use machine registers */ #undef NO_USE_REGS /* Define if you don't want to use the ebp register on ix86 */ #undef NO_USE_EBP /* Define if you don't want to fast call on ix86 */ #undef NO_USE_FAST_CALL /* Define if you don't want to include line editor facility */ #undef NO_USE_LINEDIT /* Define if you don't want consult/1 launches pl2wam with pipe on its input */ #undef NO_USE_PIPED_STDIN_FOR_CONSULT /* Define if you don't want to use the win32 GUI console */ #undef NO_USE_GUI_CONSOLE /* Define if you don't want to include sockets facility */ #undef NO_USE_SOCKETS /* Define if you don't want to include the FD constraint solver */ #undef NO_USE_FD_SOLVER /* Define if the cpu is a mips */ #undef M_mips /* Define if the cpu is an alpha */ #undef M_alpha /* Define if the cpu is a sparc */ #undef M_sparc /* Define if the cpu is a sparc64 */ #undef M_sparc64 /* Define if the cpu is a ix86 */ #undef M_ix86 /* Define if the cpu is a powerpc */ #undef M_powerpc /* Define if the cpu is a x86-64 */ #undef M_x86_64 /* Define if the OS is an SGI IRIX */ #undef M_irix /* Define if the OS is an DEC OSF1 */ #undef M_osf /* Define if the OS is a sunos */ #undef M_sunos /* Define if the OS is a solaris */ #undef M_solaris /* Define if the OS is a linux */ #undef M_linux /* Define if the OS is a darwin */ #undef M_darwin /* Define if the OS is a WinXX based on Cygwin */ #undef M_cygwin /* Define if the OS is a WIN32 */ #undef M_win32 /* Define if the OS is a WIN64 (in addition to M_win32) */ #undef M_win64 /* Define if the OS is a SCO */ #undef M_sco /* Define if the OS is a (Free/Open/Net)BSD */ #undef M_bsd /* Define if the system is an mips/irix */ #undef M_mips_irix /* Define if the system is an alpha/linux */ #undef M_alpha_linux /* Define if the system is an alpha/OSF1 */ #undef M_alpha_osf /* Define if the system is a ix86/linux */ #undef M_ix86_linux /* Define if the system is a ix86/sco */ #undef M_ix86_sco /* Define if the system is a ix86/freebsd or openbsd or netbsd */ #undef M_ix86_bsd /* Define if the system is a ix86/cygwin */ #undef M_ix86_cygwin /* Define if the system is a ix86/mingw */ #undef M_ix86_mingw /* Define if the system is a ix86/win32 */ #undef M_ix86_win32 /* Define if the system is a ix86/darwin */ #undef M_ix86_darwin /* Define if the system is a ix86/solaris */ #undef M_ix86_solaris /* Define if the system is a sparc/solaris */ #undef M_sparc_solaris /* Define if the system is a sparc/sunos */ #undef M_sparc_sunos /* Define if the system is a sparc/bsd */ #undef M_sparc_bsd /* Define if the system is a sparc64/bsd */ #undef M_sparc64_bsd /* Define if the system is a powerpc/linux */ #undef M_powerpc_linux /* Define if the system is a powerpc/darwin */ #undef M_powerpc_darwin /* Define if the system is a powerpc/bsd */ #undef M_powerpc_bsd /* Define if the system is a x86-64/linux */ #undef M_x86_64_linux /* Define if the system is a x86-64/solaris */ #undef M_x86_64_solaris /* Define if the system is a x86-64/bsd */ #undef M_x86_64_bsd /* Define if the system is a x86-64/mingw */ #undef M_x86_64_mingw /* Define if the system is a x86-64/darwin */ #undef M_x86_64_darwin /* Define if building universal (internal helper macro) */ #undef AC_APPLE_UNIVERSAL_BUILD /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel). */ #if defined AC_APPLE_UNIVERSAL_BUILD # if defined __BIG_ENDIAN__ # define WORDS_BIGENDIAN 1 # endif #else # ifndef WORDS_BIGENDIAN # undef WORDS_BIGENDIAN # endif #endif /* Constant definitions */ #define PROLOG_DIALECT any #define PROLOG_NAME any #define PROLOG_VERSION any #define PROLOG_DATE any #define PROLOG_COPYRIGHT any #define TOP_LEVEL any #define GPLC any #define HEXGPLC any #define ENV_VARIABLE any #define M_VENDOR any #define M_CPU any #define M_OS any #define CC any #define CFLAGS_PREFIX_REG any #define CFLAGS any #define CFLAGS_MACHINE any #define LDFLAGS any #define LDLIBS any #define AS any #define ASFLAGS any #define STRIP any #define ASM_SUFFIX any #define OBJ_SUFFIX any #define EXE_SUFFIX any #define CC_OBJ_NAME_OPT any #define CC_EXE_NAME_OPT any /* define if Windows HtmlHelp is used 1=static (-lhtmlhelp), 2=dynamic (DLL) */ #undef WITH_HTMLHELP #define DLL_W32GUICONS any #define LIB_LINEDIT any #define LIB_ENGINE_PL any #define LIB_BIPS_PL any #define LIB_ENGINE_FD any #define LIB_BIPS_FD any #define SIZEOF_LONG any #define SIZEOF_VOIDP any #define SIZEOF_PTR SIZEOF_VOIDP #define WORD_SIZE (8 * SIZEOF_PTR) /* Define if socklen_t is not defined */ #undef socklen_t /* Define if you have a working sigaction to detect SIGSEGV bad addr */ #undef HAVE_WORKING_SIGACTION /* Define if obj chain needs to reverse order of collected objects */ #undef OBJ_CHAIN_REVERSE_ORDER #include "arch_dep.h" #include "pl_long.h" #endif /* !_GP_CONFIG_H */ �����������������������������������������������gprolog-1.4.5/src/EnginePl/wam_stacks.h�������������������������������������������������������������0000644�0001750�0001750�00000003763�13020764326�016133� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/* this file is automatically generated by pl_config.c */ #define NB_OF_STACKS 4 #define Trail_Stack (pl_stk_tbl[0].stack) #define Trail_Size (pl_stk_tbl[0].size) #define Trail_Offset(adr) ((WamWord *)(adr) - Trail_Stack) #define Trail_Used_Size Trail_Offset(TR) #define Cstr_Stack (pl_stk_tbl[1].stack) #define Cstr_Size (pl_stk_tbl[1].size) #define Cstr_Offset(adr) ((WamWord *)(adr) - Cstr_Stack) #define Cstr_Used_Size Cstr_Offset(CS) #define Global_Stack (pl_stk_tbl[2].stack) #define Global_Size (pl_stk_tbl[2].size) #define Global_Offset(adr) ((WamWord *)(adr) - Global_Stack) #define Global_Used_Size Global_Offset(H) #define Local_Stack (pl_stk_tbl[3].stack) #define Local_Size (pl_stk_tbl[3].size) #define Local_Offset(adr) ((WamWord *)(adr) - Local_Stack) #define Local_Used_Size Local_Offset(Local_Top) #define Stack_Top(s) (((s) == 0) ? TR : ((s) == 1) ? CS : ((s) == 2) ? H : Local_Top) typedef struct { char *name; char *desc; char *env_var_name; PlLong *p_def_size; /* used for fixed_sizes */ int default_size; /* in WamWords */ int size; /* in WamWords */ WamWord *stack; }InfStack; #ifdef ENGINE_FILE /* these variables can be overwritten by top_comp.c (see stack size file) */ PlLong pl_def_trail_size; PlLong pl_def_cstr_size; PlLong pl_def_global_size; PlLong pl_def_local_size; PlLong pl_fixed_sizes; InfStack pl_stk_tbl[] = { { "trail", "Trail Stack (undo)", "TRAILSZ", &pl_def_trail_size, 2097152, 0, NULL }, { "cstr", "Cstr Stack (constraints)", "CSTRSZ", &pl_def_cstr_size, 2097152, 0, NULL }, { "global", "Global Stack (heap)", "GLOBALSZ", &pl_def_global_size, 4194304, 0, NULL }, { "local", "Local Stack (control)", "LOCALSZ", &pl_def_local_size, 2097152, 0, NULL } }; #else extern PlLong pl_def_trail_size; extern PlLong pl_def_cstr_size; extern PlLong pl_def_global_size; extern PlLong pl_def_local_size; extern PlLong pl_fixed_sizes; extern InfStack pl_stk_tbl[]; #endif �������������gprolog-1.4.5/src/EnginePl/oper.h�������������������������������������������������������������������0000644�0001750�0001750�00000010643�13021324543�014731� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : oper.h * * Descr.: operator table management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_PREC 1200 #define MAX_ARG_OF_FUNCTOR_PREC 999 #define Make_Oper_Key(a, t) (((PlULong) (a) << 2) | (t)) #define Atom_Of_Oper(k) ((PlULong) (k) >> 2) #define Type_Of_Oper(k) ((PlULong) (k) & 3) /* operator type */ #define PREFIX 0 #define POSTFIX 1 #define INFIX 2 #define Make_Op_Mask(type) (1<<(type)) /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct /* Operator information */ { /* ------------------------------ */ PlLong a_t; /* key is <atom,operator type> */ int prec; /* precedence of the operator */ int left; /* precedence of the operator lhs */ int right; /* precedence of the operator rhs */ } OperInf; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef OPER_FILE char *pl_oper_tbl; #else extern char *pl_oper_tbl; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Init_Oper(void); OperInf *Pl_Create_Oper(int atom_op, int type, int prec, int left, int right); OperInf *Pl_Lookup_Oper(int atom_op, int type); OperInf *Pl_Lookup_Oper_Any_Type(int atom_op); OperInf *Pl_Delete_Oper(int atom_op, int type); #define Check_Oper(atom_op, type) \ (pl_atom_tbl[(atom_op)].prop.op_mask & Make_Op_Mask(type)) #define Check_Oper_Any_Type(atom_op) \ (pl_atom_tbl[(atom_op)].prop.op_mask) ���������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/hash.h�������������������������������������������������������������������0000644�0001750�0001750�00000007423�13021324543�014711� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : hash.h * * Descr.: hash table management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { char *endt; char *cur_t; char *cur_p; } HashScan; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ char *Pl_Hash_Alloc_Table(int tbl_size, int elem_size); void Pl_Hash_Free_Table(char *tbl); char *Pl_Hash_Realloc_Table(char *tbl, int new_tbl_size); void Pl_Hash_Delete_All(char *tbl); char *Pl_Hash_Insert(char *tbl, char *elem, int replace); char *Pl_Hash_Find(char *tbl, PlLong key); char *Pl_Hash_Delete(char *tbl, PlLong key); char *Pl_Hash_First(char *tbl, HashScan *scan); char *Pl_Hash_Next(HashScan *scan); int Pl_Hash_Table_Size(char *tbl); int Pl_Hash_Nb_Elements(char *tbl); #ifdef DEBUG void Hash_Check_Table(char *tbl); #endif ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/pl_config.c��������������������������������������������������������������0000644�0001750�0001750�00000104256�13021324543�015723� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : configuration * * File : pl_config.c * * Descr.: C Compiler options and WAM Configuration * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <string.h> #include <ctype.h> #include "gp_config.h" #include "machine.h" /*---------------------------------* * Constants * *---------------------------------*/ #define STR_LENGTH 512 #define FILE_WAM_ARCHI_DEF "wam_archi.def" #define FILE_WAM_ARCHI_H "wam_archi.h" #define FILE_WAM_REGS_H "wam_regs.h" #define FILE_WAM_STACKS_H "wam_stacks.h" #define FILE_GPROLOG_CST_H "gprolog_cst.h" /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { char *mach_reg_name; char *pl_reg_name; char *type; } UsedMachRegInf; typedef struct { char type[32]; char name[32]; } RegInf; typedef enum { SHORT_UNS, LONG_INT, ADDRESS } TypTag; typedef struct { char name[32]; TypTag type; int value; } TagInf; typedef struct { char name[32]; char desc[64]; int def_size; char top_macro[128]; } StackInf; /*---------------------------------* * Global Variables * *---------------------------------*/ UsedMachRegInf used_mach_reg[256]; int nb_of_used_mach_regs; char save_str[STR_LENGTH]; FILE *fw_r; FILE *fw_s; FILE *fg_c; /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Generate_Archi(void); void Write_C_Compiler_Info(void); void Write_GProlog_Cst(void); char *Read_Identifier(char *s, int fail_if_error, char **end); char *Read_String(char *s, char **end); int Pl_Read_Integer(char *s, char **end); void Generate_Regs(FILE *f, FILE *g); void Generate_Tags(FILE *f, FILE *g); void Generate_Stacks(FILE *f, FILE *g); void Pl_Fatal_Error(char *format, ...); /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(void) { int i; if (*M_CPU == '?') { printf("*** This architecture is not supported ***\n"); return 1; } if (WORD_SIZE != (sizeof(PlLong) * 8)) { printf("Bad Value of WORD_SIZE - should be %d\n", (int) (sizeof(PlLong) * 8)); return 1; } if ((fw_r = fopen(FILE_WAM_REGS_H, "wb")) == NULL) Pl_Fatal_Error("cannot open %s", FILE_WAM_REGS_H); fprintf(fw_r, "/* this file is automatically generated by pl_config.c */\n"); fprintf(fw_r, "\n#include \"gp_config.h\"\n\n"); if ((fw_s = fopen(FILE_WAM_STACKS_H, "wb")) == NULL) Pl_Fatal_Error("cannot open %s", FILE_WAM_STACKS_H); fprintf(fw_s, "/* this file is automatically generated by pl_config.c */\n"); if ((fg_c = fopen(FILE_GPROLOG_CST_H, "wb")) == NULL) Pl_Fatal_Error("cannot open %s", FILE_GPROLOG_CST_H); #if 0 fprintf(fg_c, "/* this file is automatically generated by pl_config.c */\n"); #endif printf("\n"); printf("\t-------------------------------\n"); printf("\t--- GNU PROLOG INSTALLATION ---\n"); printf("\t-------------------------------\n\n"); printf("GNU Prolog version: %s (%s)\n", PROLOG_VERSION, PROLOG_DATE); printf("Operating system : %s\n", M_OS); printf("Processor : %s\n", M_CPU); printf("Size of a WAM word: %d bits\n", (int) WORD_SIZE); printf("C compiler : %s\n", CC); printf("C flags : %s\n", CFLAGS); printf("C flags machine : %s\n", CFLAGS_MACHINE); printf("Assembler : %s\n", AS); printf("Assembler flags : %s\n", ASFLAGS); printf("Loader flags : %s\n", LDFLAGS); printf("Loader libraries : %s\n", LDLIBS); printf("Use line editor : %s\n", #ifndef NO_USE_LINEDIT "Yes" #else "No" #endif ); printf("Use piped consult : %s\n", #ifndef NO_USE_PIPED_STDIN_FOR_CONSULT "Yes" #else "No" #endif ); #ifdef _WIN32 printf("Use GUI console : %s\n", #ifdef W32_GUI_CONSOLE "Yes" #else "No" #endif ); #endif #ifdef W32_GUI_CONSOLE printf("Use HtmlHelp : %s\n", #if defined(WITH_HTMLHELP) && WITH_HTMLHELP == 1 "Yes (statically linked)" #elif defined(WITH_HTMLHELP) && WITH_HTMLHELP == 2 "Yes (dynamically loaded)" #else "No" #endif ); #endif printf("Use sockets : %s\n", #ifndef NO_USE_SOCKETS "Yes" #else "No" #endif ); printf("Use FD solver : %s\n", #ifndef NO_USE_FD_SOLVER "Yes" #else "No" #endif ); #ifdef COULD_COMPILE_FOR_FC printf("Use fast call : %s\n", #ifndef NO_USE_FAST_CALL "Yes" #else "No" #endif ); #endif printf("Use machine regs. : %s\n", #ifndef NO_USE_REGS "Yes" #else "No" #endif ); Write_GProlog_Cst(); Generate_Archi(); Write_C_Compiler_Info(); #if 0 fprintf(fg_c, "/* end of automatically generated part */\n"); #endif fclose(fw_r); fclose(fw_s); fclose(fg_c); printf("Used register(s) : "); for (i = 0; i < nb_of_used_mach_regs; i++) printf("%s (%s) ", used_mach_reg[i].mach_reg_name, used_mach_reg[i].pl_reg_name); printf("\n"); printf("\n"); printf("\t------------------------------\n\n"); return 0; } /*-------------------------------------------------------------------------* * WRITE_GPROLOG_CST * * * *-------------------------------------------------------------------------*/ void Write_GProlog_Cst(void) { int major, minor, patch_level; sscanf(PROLOG_VERSION, "%d.%d.%d", &major, &minor, &patch_level); fputc('\n', fg_c); fprintf(fg_c, "#define __GNU_PROLOG__ \t%d\n", major); fprintf(fg_c, "#define __GPROLOG__ \t%d\n", major); fprintf(fg_c, "#define __GPROLOG_MINOR__ \t%d\n", minor); fprintf(fg_c, "#define __GPROLOG_PATCHLEVEL__\t%d\n", patch_level); fprintf(fg_c, "#define __GPROLOG_VERSION__ \t%d\n", major * 10000 + minor * 100 + patch_level); fputc('\n', fg_c); fprintf(fg_c, "#define PROLOG_DIALECT \t\"" PROLOG_DIALECT "\"\n"); fprintf(fg_c, "#define PROLOG_NAME \t\"" PROLOG_NAME "\"\n"); fprintf(fg_c, "#define PROLOG_VERSION \t\"" PROLOG_VERSION "\"\n"); fprintf(fg_c, "#define PROLOG_DATE \t\"" PROLOG_DATE "\"\n"); fprintf(fg_c, "#define PROLOG_COPYRIGHT\t\"" PROLOG_COPYRIGHT "\"\n"); fputc('\n', fg_c); } /*-------------------------------------------------------------------------* * WRITE_C_COMPILER_INFO * * * *-------------------------------------------------------------------------*/ void Write_C_Compiler_Info(void) { int i; fputc('\n', fw_r); fprintf(fw_r, "#define CFLAGS_REGS\t\t\""); for (i = 0; i < nb_of_used_mach_regs; i++) { fprintf(fw_r, CFLAGS_PREFIX_REG, used_mach_reg[i].mach_reg_name); fputc(' ', fw_r); } fputs("\"\n", fw_r); } /*-------------------------------------------------------------------------* * GENERATE_ARCHI * * * *-------------------------------------------------------------------------*/ void Generate_Archi(void) { FILE *f, *g; static char str[STR_LENGTH]; char *p1, *p2; if ((f = fopen(FILE_WAM_ARCHI_DEF, "rt")) == NULL) Pl_Fatal_Error("cannot open %s", FILE_WAM_ARCHI_DEF); if ((g = fopen(FILE_WAM_ARCHI_H, "wb")) == NULL) Pl_Fatal_Error("cannot open %s", FILE_WAM_ARCHI_H); while (!feof(f) && fgets(str, sizeof(str), f)) { if (*str != '@') { fputs(str, g); continue; } strcpy(save_str, str); p1 = Read_Identifier(str + 1, 1, &p2); if (strcmp(p1, "begin") != 0) Pl_Fatal_Error("Syntax error: incorrect @ declaration in: %s", save_str); p1 = Read_Identifier(p2 + 1, 1, &p2); if (strcmp(p1, "regs") == 0) { Generate_Regs(f, g); continue; } if (strcmp(p1, "tags") == 0) { Generate_Tags(f, g); continue; } if (strcmp(p1, "stacks") == 0) { Generate_Stacks(f, g); continue; } Pl_Fatal_Error("Syntax error: unknown section in: %s", save_str); } fclose(f); fclose(g); } /*-------------------------------------------------------------------------* * READ_IDENTIFIER * * * *-------------------------------------------------------------------------*/ char * Read_Identifier(char *s, int fail_if_error, char **end) { while (isspace(*s)) s++; *end = s; if (!isalpha(**end)) { if (fail_if_error) Pl_Fatal_Error("Syntax error: identifier expected in: %s", save_str); else return NULL; } do (*end)++; while (isalnum(**end) || **end == '_'); if (!isspace(**end)) Pl_Fatal_Error("Syntax error: space expected after identifier in: %s", save_str); **end = '\0'; return s; } /*-------------------------------------------------------------------------* * READ_STRING * * * *-------------------------------------------------------------------------*/ char * Read_String(char *s, char **end) { while (isspace(*s)) s++; if (*s != '"') Pl_Fatal_Error("Syntax error: string expected in: %s", save_str); for(*end = s + 1; **end != '"'; (*end)++) if (**end == '\0') Pl_Fatal_Error("Syntax error: string expected in: %s", save_str); (*end)++; **end = '\0'; return s; /* NB: returned string contains double-quotes */ } /*-------------------------------------------------------------------------* * PL_READ_INTEGER * * * *-------------------------------------------------------------------------*/ int Pl_Read_Integer(char *s, char **end) { int x = 0; while (isspace(*s)) s++; *end = s; if (!isdigit(**end)) Pl_Fatal_Error("Syntax error: integer expected in: %s", save_str); do { x = x * 10 + **end - '0'; (*end)++; } while (isdigit(**end) || **end == '_'); if (!isspace(**end)) Pl_Fatal_Error("Syntax error: space expected after identifier in: %s", save_str); **end = '\0'; return x; } /*-------------------------------------------------------------------------* * GENERATE_REGS * * * * initial filler description * * @filler size * * * * register description: * * @reg priority type name * * priority: 1-9 (1:high, 9:low) * * type must be machine word castable (ex int unsigned pointer...) * * * *-------------------------------------------------------------------------*/ void Generate_Regs(FILE *f, FILE *g) { char *p1, *p2; static char str[STR_LENGTH]; char str_base[32] = ""; char *used_regs[] = M_USED_REGS; char **p = used_regs; RegInf reg[10][50]; int nb_reg[10] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; RegInf *dp; int total_nb_reg = 0; int nb_not_alloc = 0; int regs_to_save_for_signal; int i, j, k; #ifdef NO_USE_REGS p[0] = NULL; #endif for (;;) { if (feof(f) || !fgets(str, sizeof(str), f)) Pl_Fatal_Error("Syntax error: end expected for @begin reg"); if (*str != '@') { if (*str != '\n') fputs(str, g); continue; } strcpy(save_str, str); p1 = Read_Identifier(str + 1, 1, &p2); if (strcmp(p1, "end") == 0) break; if (strcmp(p1, "filler") == 0) { p1 = Read_Identifier(p2 + 1, 0, &p2); if (!p1) { i = Pl_Read_Integer(p2, &p2); p1 = str; sprintf(p1, "%d", i); } sprintf(str_base + strlen(str_base), "%s+", p1); continue; } if (strcmp(p1, "reg") == 0) { i = Pl_Read_Integer(p2 + 1, &p2); strcpy(reg[i][nb_reg[i]].type, Read_Identifier(p2 + 1, 1, &p2)); strcpy(reg[i][nb_reg[i]].name, Read_Identifier(p2 + 1, 1, &p2)); nb_reg[i]++; continue; } Pl_Fatal_Error("Syntax error: incorrect @ declaration in: %s", save_str); } fprintf(g, "\n\n /*--- Begin Register Generation ---*/\n\n"); #ifndef NO_MACHINE_REG_FOR_REG_BANK if (*p) { used_mach_reg[nb_of_used_mach_regs].mach_reg_name = *p; used_mach_reg[nb_of_used_mach_regs].pl_reg_name = "pl_reg_bank"; used_mach_reg[nb_of_used_mach_regs].type = "WamWordP"; nb_of_used_mach_regs++; fprintf(g, "register WamWord \t\t*pl_reg_bank asm (\"%s\");\n\n", *p); fprintf(fw_r, "#define MAP_REG_BANK\t\t\"%s\"\n\n", *p); p++; } else { fprintf(g, "#ifdef ENGINE_FILE\n\n"); fprintf(g, " WamWord \t\t\t*pl_reg_bank;\n"); fprintf(g, "\n#else\n\n"); fprintf(g, "extern WamWord \t\t\t*pl_reg_bank;\n"); fprintf(g, "\n#endif\n\n"); } #endif for (i = 0; i < 10; i++) for (j = 0, total_nb_reg += nb_reg[i]; j < nb_reg[i]; j++) { dp = ®[i][j]; if (*p) { used_mach_reg[nb_of_used_mach_regs].mach_reg_name = *p; used_mach_reg[nb_of_used_mach_regs].pl_reg_name = dp->name; used_mach_reg[nb_of_used_mach_regs].type = dp->type; nb_of_used_mach_regs++; fprintf(g, "register %s\t\t%-3s asm (\"%s\");\n", dp->type, dp->name, *p); fprintf(fw_r, "#define MAP_REG_%-10s\t\"%s\"\n", dp->name, *p++); if (!*p) fprintf(g, "\n\n"); } else { fprintf(g, "#define %s\t\t\t(((%-8s *) pl_reg_bank)[%s%d])\n", dp->name, dp->type, str_base, nb_not_alloc); fprintf(fw_r, "#define MAP_OFFSET_%-6s\t((%s%d)*%d)\n", dp->name, str_base, nb_not_alloc++, (int) sizeof(PlLong)); } } fprintf(g, "\n\n"); fprintf(g, "#define NB_OF_REGS \t%d\n", total_nb_reg); fprintf(g, "#define NB_OF_ALLOC_REGS \t%d\n", total_nb_reg - nb_not_alloc); fprintf(g, "#define NB_OF_NOT_ALLOC_REGS\t%d\n", nb_not_alloc); fprintf(g, "#define REG_BANK_SIZE \t(%sNB_OF_NOT_ALLOC_REGS)\n", str_base); fprintf(g, "\n\n\n\n#define NB_OF_USED_MACHINE_REGS %d\n", nb_of_used_mach_regs); /* same as NB_OF_ALLOC_REGS :-) ? */ #ifndef NO_MACHINE_REG_FOR_REG_BANK /* pl_reg_bank restored anyway */ regs_to_save_for_signal = (nb_of_used_mach_regs > 1); #else regs_to_save_for_signal = (nb_of_used_mach_regs >= 1); #endif fprintf(g, "\n"); fprintf(g, "#ifdef ENGINE_FILE\n\n"); #ifdef NO_MACHINE_REG_FOR_REG_BANK fprintf(g, "WamWord pl_reg_bank[REG_BANK_SIZE];\n"); #else fprintf(g, "WamWord *save_reg_bank;\n\n"); #endif if (regs_to_save_for_signal) fprintf(g, "WamWord pl_buff_signal_reg[NB_OF_USED_MACHINE_REGS + 1];\n\n"); fprintf(g, "char *pl_reg_tbl[] = { "); k = 0; for (i = 0; i < 10; i++) for (j = 0; j < nb_reg[i]; j++) { dp = ®[i][j]; fprintf(g, "\"%s\"%s", dp->name, k < total_nb_reg - 1 ? ", " : "};\n"); k++; } fprintf(g, "\n#else\n\n"); #ifdef NO_MACHINE_REG_FOR_REG_BANK fprintf(g, "extern WamWord pl_reg_bank[];\n"); #else fprintf(g, "extern WamWord *save_reg_bank;\n\n"); #endif if (regs_to_save_for_signal) fprintf(g, "extern WamWord pl_buff_signal_reg[];\n\n"); fprintf(g, "extern char *pl_reg_tbl[];\n"); fprintf(g, "\n#endif\n\n"); #ifndef NO_MACHINE_REG_FOR_REG_BANK fprintf(g, "#define Init_Reg_Bank(x) save_reg_bank = pl_reg_bank = x\n"); #else fprintf(g, "#define Init_Reg_Bank(x)\n"); #endif fprintf(g, "\n\n"); fprintf(g, "#define Reg(i)\t\t\t("); k = 0; for (i = 0; i < 10; i++) for (j = 0; j < nb_reg[i]; j++) { dp = ®[i][j]; if (k < total_nb_reg - 1) fprintf(g, "((i)==%d) ? (WamWord) %-3s\t: \\\n\t\t\t\t ", k++, dp->name); else fprintf(g, " (WamWord) %s)\n", dp->name); } fprintf(g, "\n\n\n\n#define Save_All_Regs(buff_save) \\\n"); fprintf(g, " do { \\\n"); k = 0; for (i = 0; i < 10; i++) for (j = 0; j < nb_reg[i]; j++) { dp = ®[i][j]; fprintf(g, " buff_save[%d] = (WamWord) %s; \\\n", k, dp->name); k++; } fprintf(g, " } while(0)\n"); fprintf(g, "\n\n\n\n#define Restore_All_Regs(buff_save) \\\n"); fprintf(g, " do { \\\n"); k = 0; for (i = 0; i < 10; i++) for (j = 0; j < nb_reg[i]; j++) { dp = ®[i][j]; fprintf(g, " %-6s = (%-8s) buff_save[%d]; \\\n", dp->name, dp->type, k); k++; } fprintf(g, " } while(0)\n"); fprintf(g, "\n\n\n\n#define Save_Machine_Regs(buff_save) \\\n"); fprintf(g, " do { \\\n"); for (i = 0; i < nb_of_used_mach_regs; i++) fprintf(g, " buff_save[%d] = (WamWord) %s; \\\n", i, used_mach_reg[i].pl_reg_name); fprintf(g, " } while(0)\n"); fprintf(g, "\n\n#define Restore_Machine_Regs(buff_save) \\\n"); fprintf(g, " do { \\\n"); for (i = 0; i < nb_of_used_mach_regs; i++) fprintf(g, " %s = (%-8s) buff_save[%d]; \\\n", used_mach_reg[i].pl_reg_name, used_mach_reg[i].type, i); fprintf(g, " } while(0)\n"); if (regs_to_save_for_signal) { fprintf(g, "\n\n\n\n#define Start_Protect_Regs_For_Signal \\\n"); fprintf(g, " do { \\\n"); fprintf(g, " Save_Machine_Regs(pl_buff_signal_reg); \\\n"); fprintf(g, " pl_buff_signal_reg[NB_OF_USED_MACHINE_REGS] = 1; \\\n"); fprintf(g, " } while(0)\n"); fprintf(g, "\n\n#define Stop_Protect_Regs_For_Signal \\\n"); fprintf(g, " pl_buff_signal_reg[NB_OF_USED_MACHINE_REGS] = 0; \\\n"); fprintf(g, "\n\n#define Restore_Protect_Regs_For_Signal \\\n"); fprintf(g, " do { \\\n"); fprintf(g, " if (pl_buff_signal_reg[NB_OF_USED_MACHINE_REGS]) { \\\n"); fprintf(g, " Restore_Machine_Regs(pl_buff_signal_reg); \\\n"); fprintf(g, " Stop_Protect_Regs_For_Signal; \\\n"); fprintf(g, " } \\\n"); #ifndef NO_MACHINE_REG_FOR_REG_BANK fprintf(g, " pl_reg_bank = save_reg_bank; \\\n"); #endif fprintf(g, " } while(0)\n"); } else { fprintf(g, "\n\n\n\n#define Start_Protect_Regs_For_Signal\n"); fprintf(g, "\n\n#define Stop_Protect_Regs_For_Signal\n"); fprintf(g, "\n\n#define Restore_Protect_Regs_For_Signal\n"); } fprintf(g, "\n\n /*--- End Register Generation ---*/\n\n"); } /*-------------------------------------------------------------------------* * GENERATE_TAGS * * * * tag description: * * @tag name type value * * type: long_int/short_uns/address * * value: >= 0 * *-------------------------------------------------------------------------*/ void Generate_Tags(FILE *f, FILE *g) { static char str[STR_LENGTH]; char *p1, *p2; TagInf tag[128]; int nb_tag = 0; int tag_size, tag_size_low, tag_size_high, value_size; int max_value = 0; PlULong tag_mask; PlLong min_integer, max_integer; int i; for (;;) { if (feof(f) || !fgets(str, sizeof(str), f)) Pl_Fatal_Error("Syntax error: end expected for @begin tag"); if (*str != '@') { if (*str != '\n') fputs(str, g); continue; } strcpy(save_str, str); p1 = Read_Identifier(str + 1, 1, &p2); if (strcmp(p1, "end") == 0) break; if (strcmp(p1, "tag") == 0) { strcpy(tag[nb_tag].name, Read_Identifier(p2 + 1, 1, &p2)); p1 = Read_Identifier(p2 + 1, 1, &p2); if (strcmp(p1, "long_int") == 0) tag[nb_tag].type = LONG_INT; else if (strcmp(p1, "short_uns") == 0) tag[nb_tag].type = SHORT_UNS; else if (strcmp(p1, "address") == 0) tag[nb_tag].type = ADDRESS; else Pl_Fatal_Error("Syntax error: wrong tag type in: %s", save_str); tag[nb_tag].value = Pl_Read_Integer(p2 + 1, &p2); if (tag[nb_tag].value > max_value) max_value = tag[nb_tag].value; nb_tag++; continue; } Pl_Fatal_Error("Syntax error: incorrect @ declaration in: %s", save_str); } fprintf(g, "\n\n /*--- Begin Tag Generation ---*/\n\n"); #define Mk_Tag_Mask(x) ((((PlULong) (x) >> tag_size_low) << (value_size + tag_size_low)) | ((x) & ((1 << tag_size_low) - 1))) #if 0 tag_size = 4; #else max_value++; if (max_value < nb_tag) Pl_Fatal_Error("There is an invalid tag value (repetition ?)\n"); for (tag_size = 0; (1 << tag_size) < max_value; tag_size++) ; #endif #if WORD_SIZE == 32 tag_size_low = 2; #else tag_size_low = 3; #endif tag_size_high = tag_size - tag_size_low; value_size = WORD_SIZE - tag_size; tag_mask = Mk_Tag_Mask((1 << tag_size) - 1); max_integer = ((PlLong) 1 << (WORD_SIZE - tag_size - 1)) - 1; min_integer = -max_integer - 1; fprintf(fg_c, "#define PL_MIN_INTEGER\t\t%" PL_FMT_d "\n", min_integer); fprintf(fg_c, "#define PL_MAX_INTEGER\t\t%" PL_FMT_d "\n", max_integer); fputc('\n', fg_c); fprintf(g, "#define TAG_SIZE \t\t%d\n", tag_size); fprintf(g, "#define TAG_SIZE_LOW \t\t%d\n", tag_size_low); fprintf(g, "#define TAG_SIZE_HIGH\t\t%d\n", tag_size_high); fprintf(g, "#define VALUE_SIZE \t\t%d\n", value_size); fprintf(g, "#define TAG_MASK \t\t(PlULong)%#" PL_FMT_x "\n", tag_mask); fprintf(g, "#define VALUE_MASK \t\t(PlULong)%#" PL_FMT_x "\n", ~tag_mask); fprintf(g, "#define Tag_Mask_Of(w)\t\t((PlLong) (w) & (TAG_MASK))\n"); if (tag_size_high > 0) fprintf(g, "#define Tag_From_Tag_Mask(w) \t(((PlULong) (w) >> %d) | ((w) & %d))\n", value_size, (1 << tag_size_low) -1); else fprintf(g, "#define Tag_From_Tag_Mask(w) \t(w)\n"); if (tag_size_high > 0) fprintf(g, "#define Tag_Of(w) \t\t((((PlULong) (w) >> %d) << %d) | ((w) & %d))\n", WORD_SIZE-tag_size_high, tag_size_low, (1 << tag_size_low) -1); else fprintf(g, "#define Tag_Of(w) \t\tTag_Mask_Of(w)\n"); for (i = 0; i < nb_tag; i++) { fprintf(g, "#define TAG_%s_MASK\t\t(PlULong)%#" PL_FMT_x "\n", tag[i].name, Mk_Tag_Mask(tag[i].value)); } fprintf(g, "\n"); fprintf(g, "#define NB_OF_TAGS \t%d\n", nb_tag); for (i = 0; i < nb_tag; i++) { fprintf(g, "#define %-10s \t\t%-2d\n", tag[i].name, tag[i].value); fprintf(fg_c, "#define PL_%-10s \t\t%-2d\n", tag[i].name, tag[i].value); } fprintf(g, "\n"); fprintf(g, "\t/* General Tag/UnTag macros */\n\n"); fprintf(g, "#define Tag_Long_Int(tm, v) \t((((PlLong) ((v) << %d)) >> %d) | (tm))\n", tag_size, tag_size_high); fprintf(g, "#define Tag_Short_Uns(tm, v)\t(((PlLong) (v) << %d) + (tm))\n", tag_size_low); /* For Tag_Address the + (tm) is better than | (tm) since the C compiler can * optimizes things like Tag_Address(2, H + 1) with only 1 instruction (+ 6) * instead of 2 (1 for + 4, 1 for | TAG_STC_MASK) */ fprintf(g, "#define Tag_Address(tm, v) \t((PlLong) (v) + (tm))\n"); fprintf(g, "\n"); fprintf(g, "#define UnTag_Long_Int(w) \t((PlLong) ((w) << %d) >> %d)\n", tag_size_high, tag_size); fprintf(g, "#define UnTag_Short_Uns(w)\tUnTag_Long_Int(w)\n"); fprintf(g, "#define UnTag_Address(w) \t((WamWord *) ((w) & VALUE_MASK))\n"); fprintf(g, "\n"); fprintf(g, "\n"); fprintf(g, "\t/* Specialized Tag/UnTag macros */\n\n"); fprintf(g, "\n"); for (i = 0; i < nb_tag; i++) { fprintf(g, "#define Tag_%s(v) \t\t", tag[i].name); switch(tag[i].type) { case LONG_INT: if (tag[i].value == 0) fprintf(g, "(((PlULong) (v) << %d) & VALUE_MASK)\n", tag_size_low); /* testing if high bits are 1 should suffice below - TO DO */ else if (tag[i].value == (1 << tag_size) - 1) fprintf(g, "(((PlULong) (v) << %d) | TAG_MASK)\n", tag_size_low); else fprintf(g, "Tag_Long_Int(TAG_%s_MASK, v)\n", tag[i].name); break; case SHORT_UNS: fprintf(g, "Tag_Short_Uns(TAG_%s_MASK, v)\n", tag[i].name); break; case ADDRESS: fprintf(g, "Tag_Address(TAG_%s_MASK, v)\n", tag[i].name); break; } } fprintf(g, "\n"); for (i = 0; i < nb_tag; i++) { fprintf(g, "#define UnTag_%s(w) \t\t", tag[i].name); switch(tag[i].type) { case LONG_INT: fprintf(g, "UnTag_Long_Int(w)\n"); break; case SHORT_UNS: if (tag[i].value <= 3) fprintf(g, "((PlULong) (w) >> %d)\n", tag_size_low); else fprintf(g, "UnTag_Short_Uns(w)\n"); break; case ADDRESS: if (tag[i].value == 0) fprintf(g, "((WamWord *) (w))\n"); else fprintf(g, "UnTag_Address(w)\n"); break; } } fprintf(g, "\n"); for (i = 0; i < nb_tag; i++) { fprintf(g, "#define Tag_Is_%s(w) \t\t(Tag_Mask_Of(w) == TAG_%s_MASK)\n", tag[i].name, tag[i].name); } fprintf(g, "\ntypedef enum\n"); fprintf(g, "{\n"); fprintf(g, " LONG_INT,\n"); fprintf(g, " SHORT_UNS,\n"); fprintf(g, " ADDRESS\n"); fprintf(g, "}TypTag;\n"); fprintf(g, "\ntypedef struct\n"); fprintf(g, "{\n"); fprintf(g, " char *name;\n"); fprintf(g, " TypTag type;\n"); fprintf(g, " int value;\n"); fprintf(g, " PlLong tag_mask;\n"); fprintf(g, "}InfTag;\n\n\n"); fprintf(g, "#ifdef ENGINE_FILE\n\n"); fprintf(g, "InfTag pl_tag_tbl[] =\n{\n"); for (i = 0; i < nb_tag; i++) { fprintf(g, " { \"%s\", %s, %d, %" PL_FMT_x "}%s", tag[i].name, (tag[i].type == LONG_INT) ? "LONG_INT" : (tag[i].type == SHORT_UNS) ? "SHORT_UNS" : "ADDRESS", tag[i].value, Mk_Tag_Mask(tag[i].value), (i < nb_tag - 1) ? ",\n" : "\n};\n"); } fprintf(g, "\n#else\n\n"); fprintf(g, "extern InfTag pl_tag_tbl[];\n"); fprintf(g, "\n#endif\n"); fprintf(g, "\n\n /*--- End Tag Generation ---*/\n\n"); } /*-------------------------------------------------------------------------* * GENERATE_STACKS * * * * stack description: * * @stack name "description" default_size stack_top_macro * *-------------------------------------------------------------------------*/ void Generate_Stacks(FILE *f, FILE *g) { static char str[STR_LENGTH]; char *p1, *p2; int i; StackInf stack[12]; int nb_stack = 0; for (;;) { if (feof(f) || !fgets(str, sizeof(str), f)) Pl_Fatal_Error("Syntax error: end expected for @begin stack"); if (*str != '@') { if (*str != '\n') fputs(str, g); continue; } strcpy(save_str, str); p1 = Read_Identifier(str + 1, 1, &p2); if (strcmp(p1, "end") == 0) break; if (strcmp(p1, "stack") == 0) { strcpy(stack[nb_stack].name, Read_Identifier(p2 + 1, 1, &p2)); strcpy(stack[nb_stack].desc, Read_String(p2 + 1, &p2)); i = Pl_Read_Integer(p2 + 1, &p2); stack[nb_stack].def_size = i * 1024 / sizeof(PlLong); strcpy(stack[nb_stack].top_macro, Read_Identifier(p2 + 1, 1, &p2)); nb_stack++; continue; } Pl_Fatal_Error("Syntax error: incorrect @ declaration in: %s", save_str); } fprintf(g, "\n\n /*--- Begin Stack Generation ---*/\n\n"); fprintf(g, "#include \"wam_stacks.h\"\n"); fprintf(fw_s, "#define NB_OF_STACKS \t\t%d\n\n", nb_stack); for (i = 0; i < nb_stack; i++) { strcpy(str, stack[i].name); *str = toupper(*str); fprintf(fw_s, "#define %s_Stack \t(pl_stk_tbl[%d].stack)\n", str, i); fprintf(fw_s, "#define %s_Size \t(pl_stk_tbl[%d].size)\n", str, i); fprintf(fw_s, "#define %s_Offset(adr) \t((WamWord *)(adr) - %s_Stack)\n", str, str); fprintf(fw_s, "#define %s_Used_Size \t%s_Offset(%s)\n\n", str, str, stack[i].top_macro); } fprintf(fw_s, "\n#define Stack_Top(s) \t("); for (i = 0; i < nb_stack - 1; i++) fprintf(fw_s, "((s) == %d) ? %s : ", i, stack[i].top_macro); fprintf(fw_s, "%s)\n", stack[nb_stack - 1].top_macro); fprintf(fw_s, "\ntypedef struct\n"); fprintf(fw_s, "{\n"); fprintf(fw_s, " char *name;\n"); fprintf(fw_s, " char *desc;\n"); fprintf(fw_s, " char *env_var_name;\n"); fprintf(fw_s, " PlLong *p_def_size;\t/* used for fixed_sizes */\n"); fprintf(fw_s, " int default_size; \t/* in WamWords */\n"); fprintf(fw_s, " int size; \t/* in WamWords */\n"); fprintf(fw_s, " WamWord *stack;\n"); fprintf(fw_s, "}InfStack;\n\n\n"); fprintf(fw_s, "#ifdef ENGINE_FILE\n\n"); fprintf(fw_s, " /* these variables can be overwritten by top_comp.c (see stack size file) */\n"); for (i = 0; i < nb_stack; i++) fprintf(fw_s, "PlLong pl_def_%s_size;\n", stack[i].name); fprintf(fw_s, "PlLong pl_fixed_sizes;\n\n"); fprintf(fw_s, "InfStack pl_stk_tbl[] =\n{\n"); for (i = 0; i < nb_stack; i++) { strcpy(str, stack[i].name); for (p1 = str; *p1; p1++) *p1 = toupper(*p1); fprintf(fw_s, " { \"%s\", %s, \"%sSZ\", &pl_def_%s_size, %d, 0, NULL }%s", stack[i].name, stack[i].desc, str, stack[i].name, stack[i].def_size, (i < nb_stack - 1) ? ",\n" : "\n};\n"); } fprintf(fw_s, "\n#else\n\n"); for (i = 0; i < nb_stack; i++) fprintf(fw_s, "extern PlLong pl_def_%s_size;\n", stack[i].name); fprintf(fw_s, "extern PlLong pl_fixed_sizes;\n\n\n"); fprintf(fw_s, "extern InfStack pl_stk_tbl[];\n"); fprintf(fw_s, "\n#endif\n"); fprintf(g, "\n\n /*--- End Stack Generation ---*/\n\n"); } /*-------------------------------------------------------------------------* * PL_FATAL_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Fatal_Error(char *format, ...) { va_list arg_ptr; va_start(arg_ptr, format); vfprintf(stderr, format, arg_ptr); va_end(arg_ptr); fprintf(stderr, "\n"); exit(1); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/obj_chain.c��������������������������������������������������������������0000644�0001750�0001750�00000021274�13021324543�015675� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : obj_chain.c * * Descr.: object chaining management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include "pl_params.h" #include "gp_config.h" #include "obj_chain.h" #define DBGPRINTF printf #if 0 #define DEBUG #endif void Pl_Fatal_Error(char *format, ...); /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { void (*fct_obj_init) (); void (*fct_exec_system) (); void (*fct_exec_user) (); } ObjInf; /*---------------------------------* * Global Variables * *---------------------------------*/ static ObjInf obj_tbl[MAX_OBJECT]; static int nb_obj = 0; /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * Under WIN32 with MSVC++ 6.0 * * * * We use the possibility to define user sections in objects. We group the * * address of each initialization function in a same section (named .GPLC).* * We use 2 markers: obj_chain_begin and obj_chain_end whose address (&) * * delimit the start and the end of the initializer function address table.* * To know the start and end address in this section we cannot assume the * * (MS) linker fits the section in the order it finds the objects. However,* * if a section name contains a $ in it, the $ and all everything that * * follows will be stripped off in the executable file. Before the linker * * strips down the name, it combines the sections with names that match up * * to the $. The name portion after the $ is used in arranging the OBJ * * sections in the executable. These sections are sorted alphabetically, * * based on the portion of the name after the $. For example, 3 sections * * called .GPLC$m, .GPLC$a and .GPLC$z will be combined into a single * * section called .GPLC in the executable. The data in this section will * * start with .GPLC$a's data, continue with .GPLC$m's data and end with * * .GPLC$z's data. Inside a same (sub)section the order is unknown. * * We use $a for obj_chain_begin, $z for obj_chain_end, $m for initializers* * WARNING: when linking do not use any superflous flag (e.g. debugging), * * I have spent a lot of time to find that /ZI causes troubles (the .GPLC * * section contains much more information and then it is not correct to use* * its whole content between &obj_chain_begin and &obj_begin_stop). * *-------------------------------------------------------------------------*/ #ifdef _MSC_VER #pragma data_seg(".GPLC$a") static PlLong obj_chain_begin = 1; #pragma data_seg(".GPLC$z") static PlLong obj_chain_end = 1; #pragma data_seg() static void Accumulate_Objects(void); #endif #ifndef OBJ_CHAIN_REVERSE_ORDER #define FOR_EACH_OBJ_FROM_LAST_TO_FIRST for(i = 0; i < nb_obj; i++) #define FOR_EACH_OBJ_FROM_FIRST_TO_LAST for(i = nb_obj; --i >= 0; ) #else #define FOR_EACH_OBJ_FROM_LAST_TO_FIRST for(i = nb_obj; --i >= 0; ) #define FOR_EACH_OBJ_FROM_FIRST_TO_LAST for(i = 0; i < nb_obj; i++) #endif /*-------------------------------------------------------------------------* * PL_FIND_LINKED_OBJECTS * * * *-------------------------------------------------------------------------*/ void Pl_Find_Linked_Objects(void) { int i; #ifdef _MSC_VER Accumulate_Objects(); #endif FOR_EACH_OBJ_FROM_LAST_TO_FIRST /* call Obj Init functions */ { if (obj_tbl[i].fct_obj_init != NULL) { #ifdef DEBUG DBGPRINTF("\n+++ Executing Obj Init Function at: %p\n", (obj_tbl[i].fct_obj_init)); #endif (*(obj_tbl[i].fct_obj_init)) (); } } FOR_EACH_OBJ_FROM_FIRST_TO_LAST /* call Exec System functions */ { if (obj_tbl[i].fct_exec_system != NULL) { #ifdef DEBUG DBGPRINTF("\n+++ Executing Exec System Function at: %p\n", (obj_tbl[i].fct_exec_system)); #endif (*(obj_tbl[i].fct_exec_system)) (); } } FOR_EACH_OBJ_FROM_LAST_TO_FIRST /* call Exec User functions */ { if (obj_tbl[i].fct_exec_user != NULL) { #ifdef DEBUG DBGPRINTF("\n+++ Executing Exec User Function at: %p\n", (obj_tbl[i].fct_exec_user)); #endif (*(obj_tbl[i].fct_exec_user)) (); } } } /*-------------------------------------------------------------------------* * ACCUMULATE_OBJECTS * * * *-------------------------------------------------------------------------*/ #ifdef _MSC_VER static void Accumulate_Objects(void) { PlLong *p; void (*q) (); #ifdef DEBUG DBGPRINTF("ObjChain: chain begin: %p\n", &obj_chain_begin); DBGPRINTF("ObjChain: chain end : %p\n", &obj_chain_end); #endif p = &obj_chain_begin; while (++p < &obj_chain_end) { q = (void (*)()) *p; if (q) { #ifdef DEBUG DBGPRINTF("\n*** Obj Found addr: %p Initializer: %p\n", p, q); #endif (*q) (); } } } #endif /* MSC_VER */ /*-------------------------------------------------------------------------* * PL_NEW_OBJECT * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void Pl_New_Object(void (*fct_obj_init)(), void (*fct_exec_system) (), void (*fct_exec_user) ()) { #ifdef DEBUG DBGPRINTF("\n--> Pl_New_Object obj_init:%p exec_sys:%p exec_user:%p\n", fct_obj_init, fct_exec_system, fct_exec_user); #endif obj_tbl[nb_obj].fct_obj_init = fct_obj_init; obj_tbl[nb_obj].fct_exec_system = fct_exec_system; obj_tbl[nb_obj].fct_exec_user = fct_exec_user; nb_obj++; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/bool.h�������������������������������������������������������������������0000644�0001750�0001750�00000006073�13021324543�014721� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : configuration * * File : bool.h * * Descr.: boolean type definition - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _BOOL_H #define _BOOL_H #ifdef FALSE # if FALSE != 0 # error "FALSE already defined with a value != 0" # endif #else #define FALSE 0 #endif #ifdef TRUE # if TRUE != 1 # error "TRUE already defined with a value != 1" # endif #else #define TRUE 1 #endif #ifndef Bool typedef int Bool; #endif #endif /* !_BOOL_H */ ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/machine.h����������������������������������������������������������������0000644�0001750�0001750�00000014434�13021324543�015372� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : machine.h * * Descr.: machine dependent features - Header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _MACHINE_H #define _MACHINE_H #include "bool.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Init_Machine(void); char *Pl_M_Sys_Err_String(int ret_val); PlLong Pl_M_User_Time(void); PlLong Pl_M_System_Time(void); PlLong Pl_M_Real_Time(void); void Pl_M_Randomize(void); void Pl_M_Set_Seed(int n); int Pl_M_Get_Seed(void); int Pl_M_Random_Integer(int n); double Pl_M_Random_Float(double n); char *Pl_M_Host_Name_From_Name(char *host_name); char *Pl_M_Host_Name_From_Adr(char *host_address); char *Pl_M_Get_Working_Dir(void); Bool Pl_M_Set_Working_Dir(char *path); char *Pl_M_Absolute_Path_Name(char *src); Bool Pl_M_Is_Absolute_File_Name(char *path); char *Pl_M_Decompose_File_Name(char *path, Bool del_trail_slashes, char **base, char **suffix); #if defined(_WIN32) && !defined(__CYGWIN__) int getpagesize(void); #endif void M_Check_Magic_Words(void); /* not compiled if not needed */ /*---------------------------------* * Register Definitions * *---------------------------------*/ #if defined(M_sparc) # define M_USED_REGS {"g6", "g7", 0} #elif defined(M_mips) #define M_USED_REGS {"$16", "$17", "$18", "$19", "$20", \ "$21", "$22", "$23", 0} #elif defined(M_alpha) # define M_USED_REGS {"$9", "$10", "$11", "$12", "$13", "$14", 0} /* on M_ix86_darwin : %ebx is used by gcc for pic base */ #elif defined(M_ix86) && !defined(_MSC_VER) && !defined(M_ix86_darwin) #ifdef NO_USE_EBP # define M_USED_REGS {"ebx", 0} #else # define M_USED_REGS {"ebx", "ebp", 0} #endif #elif defined(M_powerpc) # define M_USED_REGS {"15", "20", 0} /* on M_x86_64_darwin Lion r12-r15 do not work (why ?) */ #elif defined(M_x86_64) && !defined(_MSC_VER) && !defined(M_x86_64_darwin) # define M_USED_REGS {"r12", "r13", "r14", "r15", 0} #else # define M_USED_REGS {0} #endif #if defined(M_ix86) // && !defined(_WIN32) // && !defined(NO_USE_REGS) #define NO_MACHINE_REG_FOR_REG_BANK #endif /* In any case M_x86_64_darwin needs a reg for pl_reg_bank (default is r12) * else Ma2Asm produces code ending with the following error: * '32-bit absolute addressing is not supported for x86-64' */ #if defined(NO_USE_REGS) && !defined(NO_MACHINE_REG_FOR_REG_BANK) && \ defined(M_x86_64) && !defined(M_x86_64_darwin) #define NO_MACHINE_REG_FOR_REG_BANK #endif /*---------------------------------* * Stacks Management * *---------------------------------*/ #if WORD_SIZE == 32 # define M_MMAP_HIGH_ADR1 0x0ffffff0 # define M_MMAP_HIGH_ADR2 0x3ffffff0 # define M_MMAP_HIGH_ADR3 0x7ffffff0 #elif defined(M_alpha_osf) || defined(M_alpha_linux) # define M_MMAP_HIGH_ADR1 0x3f800000000ULL #elif defined(M_x86_64_linux) || defined(M_x86_64_solaris) # define M_MMAP_HIGH_ADR1 0x4000000000ULL #endif #if defined(M_sunos) || defined(M_solaris) # define MMAP_NEEDS_FIXED #endif /*---------------------------------* * Malloc Management * *---------------------------------*/ #if defined(__OpenBSD__) || defined(M_bsd) #define USE_DL_MALLOC #endif #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/SOLARIS_SIGSEGV.c��������������������������������������������������������0000644�0001750�0001750�00000001073�13021324543�016257� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #include <signal.h> typedef long WamWord; void SIGSEGV_Handler(int sig, siginfo_t * sip) { WamWord *addr = (WamWord *) sip->si_addr; printf("Segmentation Violation at: %p\n", addr); exit(1); } main() { long *x; #if 0 signal(SIGSEGV, (void (*)()) SIGSEGV_Handler); #else struct sigaction act; act.sa_handler = NULL; act.sa_sigaction = (void (*)()) SIGSEGV_Handler; sigemptyset(&act.sa_mask); act.sa_flags = SA_SIGINFO; sigaction(SIGSEGV, &act, NULL); #endif x = (long *) 0xFEA4F124; *x = 12; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/atom.c�������������������������������������������������������������������0000644�0001750�0001750�00000043240�13021324543�014716� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : atom.c * * Descr.: atom table management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <locale.h> #include <ctype.h> #define ATOM_FILE #include "engine_pl.h" #ifndef NO_USE_LINEDIT #include "linedit.h" #endif #if 0 #define DEBUG #endif /*---------------------------------* * Constants * *---------------------------------*/ #define ERR_ATOM_NIL_INVALID "atom: invalid ATOM_NIL (should be %d)" #define ERR_TABLE_FULL_ENV "Atom table full (max atom: %d, environment variable used: %s)" #define ERR_TABLE_FULL_NO_ENV "Atom table full (max atom: %d - fixed size)" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ int pl_char_type[256] = { /* nul soh stx etx eot enq ack bel bs ht nl vt np cr so si */ LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, /* dle dc1 dc2 dc3 dc4 nak syn etb can em sub esc fs gs rs us */ LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, LA, /* spc ! " # $ % & ' ( ) * + , - . / */ LA, SC, DQ, GR, GR, CM, GR, QT, PC, PC, GR, GR, SC, GR, GR, GR, /* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */ DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, GR, SC, GR, GR, GR, GR, /* @ A B C D E F G H I J K L M N O */ GR, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, /* P Q R S T U V W X Y Z [ \ ] ^ _ */ CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, CL, PC, GR, PC, GR, UL, /* ` a b c d e f g h i j k l m n o */ BQ, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, /* p q r s t u v w x y z { | } ~ del */ SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, SL, PC, PC, PC, GR, LA /* 0x80 ... 0xff = EX (set by Init_Atom)" */ }; char pl_escape_symbol[] = "abfnrtv"; char pl_escape_char[] = "\a\b\f\n\r\t\v"; static char str_char[256][2]; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int Add_Atom(char *name, int len, unsigned hash, AtomInf *patom, Bool allocate); static AtomInf *Locate_Atom(char *name, unsigned hash); static unsigned Hash_String(char *str, int len); static void Error_Table_Full(void); /*-------------------------------------------------------------------------* * PL_INIT_ATOM * * * *-------------------------------------------------------------------------*/ void Pl_Init_Atom(void) { int i, c; if (pl_max_atom < 256) pl_max_atom = 256; if (pl_max_atom <= ATOM_NIL) pl_max_atom = ATOM_NIL + 1; /* to be sure h([]) % pl_max_atom == ATOM_NIL */ if (pl_max_atom > ((PlULong) 1 << ATOM_MAX_BITS)) /* be sure f/n words can be encoded (see wam_inst.h) */ pl_max_atom = ((PlULong) 1 << ATOM_MAX_BITS); pl_atom_tbl = (AtomInf *) Calloc(pl_max_atom, sizeof(AtomInf)); pl_nb_atom = 0; for (c = 128; c < 256; c++) { pl_char_type[c] = islower(c) ? SL : (isupper(c)) ? CL : EX; } for (i = 0; i < 256; i++) /* initial conv mapping = identity */ pl_char_conv[i] = i; for (i = 0; i < 256; i++) { str_char[i][0] = i; str_char[i][1] = '\0'; #ifndef OPTIM_1_CHAR_ATOM atom_char[i] = #endif Pl_Create_Atom(str_char[i]); } i = Pl_Create_Atom("[]"); if (i != ATOM_NIL) Pl_Fatal_Error(ERR_ATOM_NIL_INVALID, i); pl_atom_void = Pl_Create_Atom(""); pl_atom_curly_brackets = Pl_Create_Atom("{}"); pl_atom_user = Pl_Create_Atom("user"); pl_atom_system = Pl_Create_Atom("system"); pl_atom_false = Pl_Create_Atom("false"); pl_atom_true = Pl_Create_Atom("true"); pl_atom_end_of_file = Pl_Create_Atom("end_of_file"); #ifdef META_TERM_HIDDEN pl_atom_meta_term = Pl_Create_Atom("$$meta_term"); #endif } /*-------------------------------------------------------------------------* * PL_CREATE_ALLOCATE_ATOM * * * *-------------------------------------------------------------------------*/ int Pl_Create_Allocate_Atom(char *name) { int len = strlen(name); unsigned hash = Hash_String(name, len); AtomInf *patom = Locate_Atom(name, hash); return Add_Atom(name, len, hash, patom, TRUE); } /*-------------------------------------------------------------------------* * PL_CREATE_ATOM * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ int Pl_Create_Atom(char *name) { int len = strlen(name); unsigned hash = Hash_String(name, len); AtomInf *patom = Locate_Atom(name, hash); return Add_Atom(name, len, hash, patom, FALSE); } /*-------------------------------------------------------------------------* * ADD_ATOM * * * *-------------------------------------------------------------------------*/ static int Add_Atom(char *name, int len, unsigned hash, AtomInf *patom, Bool allocate) { AtomProp prop; char *p; int c_type; Bool identifier; Bool graphic; if (patom == NULL) Error_Table_Full(); if (patom->name != NULL) return patom - pl_atom_tbl; /* already exists */ if (allocate) name = Strdup(name); pl_nb_atom++; patom->name = name; patom->hash = hash; prop.needs_scan = FALSE; identifier = graphic = (*name != '\0'); for (p = name; *p; p++) { c_type = pl_char_type[(unsigned char) *p]; if ((c_type & (UL | CL | SL | DI)) == 0) identifier = FALSE; if (c_type != GR) graphic = FALSE; if ((*p != ' ' && (c_type & (QT | EX | LA))) || *p == '\\') prop.needs_scan = TRUE; } prop.length = len; #ifndef NO_USE_LINEDIT if (len > 1 && identifier) Pl_LE_Compl_Add_Word(name, len); #endif if (pl_char_type[(unsigned char) *name] != SL) /* small letter */ identifier = FALSE; if (identifier) { prop.type = IDENTIFIER_ATOM; prop.needs_quote = FALSE; goto finish; } if (graphic) { prop.type = GRAPHIC_ATOM; prop.needs_quote = (len == 1 && *name == '.') || (len == 1 && *name == '%') || (len >= 2 && name[0] == '/' && name[1] == '*') #if 0 /* this one does not need quotes it seems */ || (len == 2 && name[0] == '*' && name[1] == '/') #endif ; goto finish; } if (len == 1 && pl_char_type[(unsigned char) *name] == SC) { prop.type = SOLO_ATOM; prop.needs_quote = (*name == ','); goto finish; } prop.type = OTHER_ATOM; prop.needs_quote = prop.needs_scan || !(len == 2 && ((name[0] == '[' && name[1] == ']') || (name[0] == '{' && name[1] == '}'))); finish: prop.op_mask = 0; patom->prop = prop; return patom - pl_atom_tbl; } /*-------------------------------------------------------------------------* * PL_CREATE_ATOM_TAGGED * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ WamWord FC Pl_Create_Atom_Tagged(char *name) { return Tag_ATM(Pl_Create_Atom(name)); } /*-------------------------------------------------------------------------* * PL_FIND_ATOM * * * * return the atom key or -1 if not exist. * *-------------------------------------------------------------------------*/ int Pl_Find_Atom(char *name) { int len = strlen(name); unsigned hash = Hash_String(name, len); AtomInf *patom; patom = Locate_Atom(name, hash); return (patom == NULL || patom->name == NULL) ? -1 : patom - pl_atom_tbl; } /*-------------------------------------------------------------------------* * LOCATE_ATOM * * * * We use a specific hash table for atoms that cannot be extended but which* * provides a unique integer (0..pl_max_atom-1) that could be used in the * * future for tagged ATM words (and for structures). * * * * index (in the table) = hash code % pl_max_atom * * * * return the address of the found atom (if exists) * * the address of the corresponding free cell (if not exist) * * NULL if the table is full * *-------------------------------------------------------------------------*/ static AtomInf * Locate_Atom(char *name, unsigned hash) { int index; AtomInf *patom0, *patom, *endt; index = hash % pl_max_atom; patom = patom0 = pl_atom_tbl + index; endt = pl_atom_tbl + pl_max_atom; while (patom->name && (patom->hash != hash || strcmp(patom->name, name) != 0)) { patom++; if (patom == endt) patom = pl_atom_tbl; if (patom == patom0) /* one complete round: the table is full */ return NULL; } #if 0 if (patom->name == NULL) { if (patom != patom0) { printf("atom: (%s) collision ixd: %ld -> %ld\n", name, patom0 - pl_atom_tbl, patom - pl_atom_tbl); } if (hash != patom - pl_atom_tbl) { printf("atom: (%s) hash: %u idx: %ld\n", name, hash, patom - pl_atom_tbl); } } #endif #if 0 if (patom->name == NULL) { if (hash != index) { printf("atom: (%s) hash: %u initial idx: %d\n", name, hash, index); } } #endif return patom; } /*-------------------------------------------------------------------------* * HASH_STRING * * * * This function computes a hash key from a string. * *-------------------------------------------------------------------------*/ static unsigned Hash_String(char *str, int len) { if (len == 0) /* for 1 char string whose code is '\0' */ return 0; #ifdef OPTIM_1_CHAR_ATOM if (len == 1) /* for 1 char strings: key = char */ return (unsigned) ((unsigned char) (*str)); #endif #if 1 /* uncomment to force a given ATOM_NIL (e.g. 256 ?) */ if (len == 2 && str[0] == '[' && str[1] == ']') return ATOM_NIL; #endif #if 0 if (len == 2 && str[0] == '[' && str[1] == ']') printf("Hash([]) = %d\n", Pl_Hash_Buffer(str, len)); #endif return Pl_Hash_Buffer(str, len); } /*-------------------------------------------------------------------------* * PL_GEN_NEW_ATOM * * * * Find a new atom (gensym) beginning by a given prefix. * *-------------------------------------------------------------------------*/ int Pl_Gen_New_Atom(char *prefix) { #define GEN_SYM_CHARS "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" static char gen_sym_chars[] = GEN_SYM_CHARS; static char gen_sym_buff[1024]; #define Gen_Sym_Rand() (gen_sym_rand_next = gen_sym_rand_next * 1103515245 + 12345, (gen_sym_rand_next / 65536 % 32768)) static unsigned gen_sym_rand_next = 1; /* a simple RNG independent from the main one */ #define TRY_MAX 1 /* 1 seems better than anything else on average ! */ #ifdef DEBUG static int nb = 0; static unsigned long sum_len = 0; static unsigned max_len = 0; static unsigned long sum_try = 0; static unsigned max_try = 0; int try_count = 0; static double time0 = 0; double time, tsec = 0.0; #endif int try_no = 0; int len; unsigned hash; char *str; int c; AtomInf *patom; int atom; if (pl_nb_atom >= pl_max_atom) Error_Table_Full(); #ifdef DEBUG nb++; /* printf("GEN_SYM PREFIX : %s\n", prefix); */ #endif strcpy(gen_sym_buff, prefix); str = gen_sym_buff + strlen(prefix); for(;;) { c = Gen_Sym_Rand() % (sizeof(gen_sym_chars) - 1); /* NB: -1 for '\0' */ *str = gen_sym_chars[c]; str[1] = '\0'; len = str - gen_sym_buff + 1; hash = Hash_String(gen_sym_buff, len); #if 1 patom = Locate_Atom(gen_sym_buff, hash); #else patom = pl_atom_tbl + (hash % pl_max_atom); #endif #ifdef DEBUG try_count++; /* printf("GEN_SYM TRY %3d: %s len: %d\n", try_count, gen_sym_buff, len); */ #endif if (patom->name == NULL) break; if (++try_no == TRY_MAX) { #if 0 c = Gen_Sym_Rand() % (sizeof(gen_sym_chars) - 1); /* NB: -1 for '\0' */ *str++ = gen_sym_chars[c]; #else str++; #endif try_no = 0; } } atom = Add_Atom(gen_sym_buff, len, hash, patom, TRUE); #ifdef DEBUG sum_try += try_count; if (try_count > max_try) max_try = try_count; c = len - strlen(prefix); sum_len += c; if (c > max_len) max_len = c; if (nb % 1000 == 0) { time = (double) Pl_M_User_Time(); /* time needed for the last 1000 gensym */ tsec = (time - time0) / 1000.0; time0 = time; printf("GENSYM #%5d: %s len:%d len add:%d (avg:%d max:%d) try:%d (avg:%d max:%d) time:%.3f\n", nb, gen_sym_buff, (int) strlen(gen_sym_buff), c, (int) (sum_len / nb), max_len, try_count, (int) (sum_try / nb), max_try, tsec); } #endif return atom; } /*-------------------------------------------------------------------------* * PL_FIND_NEXT_ATOM * * * * returns the atom next after 'last_atom' (-1 to start) or -1 at the end * *-------------------------------------------------------------------------*/ int Pl_Find_Next_Atom(int last_atom) { while (++last_atom < pl_max_atom) { if (pl_atom_tbl[last_atom].name) return last_atom; } return -1; } /*-------------------------------------------------------------------------* * ERROR_TABLE_FULL * * * *-------------------------------------------------------------------------*/ static void Error_Table_Full(void) { if (pl_fixed_sizes) Pl_Fatal_Error(ERR_TABLE_FULL_NO_ENV, pl_max_atom); else Pl_Fatal_Error(ERR_TABLE_FULL_ENV, pl_max_atom, ENV_VAR_MAX_ATOM); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/misc.h�������������������������������������������������������������������0000644�0001750�0001750�00000011306�13021324543�014714� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : misc.h * * Descr.: miscellaneous operations - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ char *Pl_Malloc_Check(unsigned size, char *src_file, int src_line); char *Pl_Calloc_Check(unsigned nb, unsigned size, char *src_file, int src_line); char *Pl_Realloc_Check(char *ptr, unsigned size, char *src_file, int src_line); char *Pl_Strdup_Check(char *str, char *src_file, int src_line); #define Malloc(size) Pl_Malloc_Check(size, __FILE__, __LINE__) #define Calloc(nb, size) Pl_Calloc_Check(nb, size, __FILE__, __LINE__) #define Realloc(ptr, size) Pl_Realloc_Check(ptr, size, __FILE__, __LINE__) #define Free(ptr) free(ptr) #define Strdup(str) Pl_Strdup_Check(str, __FILE__, __LINE__) void Pl_Extend_Table_If_Needed(char **hash_tbl); void Pl_Extend_Array(char **ptbl, int *nb_elem, int elem_size, Bool bzero); void Pl_Exit_With_Value(int ret_val); void Pl_Fatal_Error(char *format, ...); /* NB: for LSB/MSB the result is undefined if x == 0 */ #if defined(__GNUC__) && __GNUC__ >= 4 && SIZEOF_LONG == SIZEOF_PTR #define Pl_Least_Significant_Bit(x) (__builtin_ctzl(x)) #define Pl_Most_Significant_Bit(x) (WORD_SIZE - 1 - __builtin_clzl(x)) #define Pl_Count_Set_Bits(x) (__builtin_popcountl(x)) #else /* !__GNUC__ || __GNUC__ < 4 || SIZEOF_LONG != SIZEOF_PTR */ #define Pl_Least_Significant_Bit(x) Pl_LSB(x) #define Pl_Most_Significant_Bit(x) Pl_MSB(x) #define Pl_Count_Set_Bits(x) Pl_Popcount(x) int Pl_LSB(PlLong x); int Pl_MSB(PlLong x); int Pl_Popcount(PlLong x); #endif /* !__GNUC__ || __GNUC__ < 4 || SIZEOF_LONG != SIZEOF_PTR */ void *Pl_Dummy_Ptr(void *p); ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/misc.c�������������������������������������������������������������������0000644�0001750�0001750�00000027404�13021324543�014715� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : misc.c * * Descr.: malloc with checks + other miscellaneous operations * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "gp_config.h" #include "machine.h" #ifdef USE_DL_MALLOC #include "dl_malloc.c" static void __attribute__((constructor)) Init_Dl_Malloc(void) { mallopt(M_MMAP_THRESHOLD, 0xFFFFFFF); /* big value to no use mmap */ } #endif #include <stdio.h> #include <stdlib.h> #include <string.h> #include <stdarg.h> #include "engine_pl.h" #ifndef NO_USE_LINEDIT #include "../Linedit/linedit.h" #endif /*---------------------------------* * Constants * *---------------------------------*/ #define ERR_ALLOC_FAULT "Memory allocation fault (%s) in %s:%d" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_MALLOC_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Malloc_Check(unsigned size, char *src_file, int src_line) { char *m = malloc(size); if (m == NULL) Pl_Fatal_Error(ERR_ALLOC_FAULT, "malloc", src_file, src_line); return m; } /*-------------------------------------------------------------------------* * PL_CALLOC_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Calloc_Check(unsigned nb, unsigned size, char *src_file, int src_line) { char *m = calloc(nb, size); if (m == NULL) Pl_Fatal_Error(ERR_ALLOC_FAULT, "calloc", src_file, src_line); return m; } /*-------------------------------------------------------------------------* * PL_REALLOC_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Realloc_Check(char *ptr, unsigned size, char *src_file, int src_line) { char *m = realloc(ptr, size); if (m == NULL) Pl_Fatal_Error(ERR_ALLOC_FAULT, "realloc", src_file, src_line); return m; } /*-------------------------------------------------------------------------* * PL_STRDUP_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Strdup_Check(char *str, char *src_file, int src_line) { char *s = strdup(str); if (s == NULL) Pl_Fatal_Error(ERR_ALLOC_FAULT, "strdup", src_file, src_line); return s; } /*-------------------------------------------------------------------------* * PL_EXTEND_TABLE_IF_NEEDED * * * *-------------------------------------------------------------------------*/ void Pl_Extend_Table_If_Needed(char **hash_tbl) { int size = Pl_Hash_Table_Size(*hash_tbl); if (Pl_Hash_Nb_Elements(*hash_tbl) >= size) *hash_tbl = Pl_Hash_Realloc_Table(*hash_tbl, size * 2); } /*-------------------------------------------------------------------------* * PL_EXTEND_ARRAY * * * *-------------------------------------------------------------------------*/ void Pl_Extend_Array(char **ptbl, int *nb_elem, int elem_size, Bool bzero) { int old_nb_elem = *nb_elem; int new_nb_elem = old_nb_elem * 2; char *new_tbl; new_tbl = Realloc(*ptbl, new_nb_elem * elem_size); if (bzero) memset(new_tbl + (old_nb_elem * elem_size), 0, (new_nb_elem - old_nb_elem) * elem_size); *ptbl = new_tbl; *nb_elem = new_nb_elem; } /*-------------------------------------------------------------------------* * PL_EXIT_WITH_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Exit_With_Value(int ret_val) { #ifndef NO_USE_LINEDIT if (pl_le_hook_exit_process) (*pl_le_hook_exit_process)(); #endif exit(ret_val); } /*-------------------------------------------------------------------------* * PL_FATAL_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Fatal_Error(char *format, ...) { va_list arg_ptr; char buff[1024]; va_start(arg_ptr, format); vsprintf(buff, format, arg_ptr); va_end(arg_ptr); #ifndef NO_USE_LINEDIT if (pl_le_hook_message_box) (*pl_le_hook_message_box)("Fatal Error", buff, 0); else #endif fprintf(stderr, "\nFatal Error: %s\n", buff); Pl_Exit_With_Value(1); } /*-------------------------------------------------------------------------* * PL_LSB * * * * Return the leas significant bit (numbered from 0). * * Result is undefined if x == 0. * *-------------------------------------------------------------------------*/ int Pl_LSB(PlLong x) { int bit = 0; #if WORD_SIZE == 64 if (x << 32 == 0) bit += 32, x >>= 32; #endif if (x << (WORD_SIZE - 32 + 16) == 0) bit += 16, x >>= 16; if (x << (WORD_SIZE - 32 + 16 + 8) == 0) bit += 8, x >>= 8; if (x << (WORD_SIZE - 32 + 16 + 8 + 4) == 0) bit += 4, x >>= 4; if (x << (WORD_SIZE - 32 + 16 + 8 + 4 + 2) == 0) bit += 2, x >>= 2; if (x << (WORD_SIZE - 32 + 16 + 8 + 4 + 2 + 1) == 0) bit += 1; return bit; } /*-------------------------------------------------------------------------* * PL_MSB * * * * Return the most significant bit (numbered from 0). * * Result is undefined if x == 0. * *-------------------------------------------------------------------------*/ int Pl_MSB(PlLong x) { int bit = WORD_SIZE - 1; #if WORD_SIZE == 64 if (x >> 32 == 0) bit -= 32, x <<= 32; #endif if (x >> (WORD_SIZE - 32 + 16) == 0) bit -= 16, x <<= 16; if (x >> (WORD_SIZE - 32 + 16 + 8) == 0) bit -= 8, x <<= 8; if (x >> (WORD_SIZE - 32 + 16 + 8 + 4) == 0) bit -= 4, x <<= 4; if (x >> (WORD_SIZE - 32 + 16 + 8 + 4 + 2) == 0) bit -= 2, x <<= 2; if (x >> (WORD_SIZE - 32 + 16 + 8 + 4 + 2 + 1) == 0) bit -= 1; return bit; } /*-------------------------------------------------------------------------* * PL_POPCOUNT * * * * Return the number of set bits. * *-------------------------------------------------------------------------*/ int Pl_Popcount(PlLong x) { static int nb_bits_in_byte[256] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8 }; int n = 0; n += nb_bits_in_byte[x & 0xFF]; n += nb_bits_in_byte[(x >> 8) & 0xFF]; n += nb_bits_in_byte[(x >> 16) & 0xFF]; n += nb_bits_in_byte[(x >> 24) & 0xFF]; #if WORD_SIZE == 64 n += nb_bits_in_byte[(x >> 32) & 0xFF]; n += nb_bits_in_byte[(x >> 40) & 0xFF]; n += nb_bits_in_byte[(x >> 48) & 0xFF]; n += nb_bits_in_byte[(x >> 56) & 0xFF]; #endif return n; } /* * This is useful until the following gcc/ld-binutils bug is not fixed: * 'Warning: alignment 8 of symbol `pl_init_stream_supp' in .../libbips_pl.a(stream_supp.o) * is smaller than 16 in .../libengine_pl.a(engine.o)' * same for `pl_fd_reset_solver' */ void * Pl_Dummy_Ptr(void *p) { return p; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/if_no_fd.h���������������������������������������������������������������0000644�0001750�0001750�00000010221�13021324543�015517� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : if_no_fd.h * * Descr.: FD interface for Prolog engine - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef IF_NO_FD_FILE void (*pl_fd_init_solver) (); /* overwritten by FD if present */ void (*pl_fd_reset_solver) (); Bool (*pl_fd_unify_with_integer) (); Bool (*pl_fd_unify_with_fd_var) (); int (*pl_fd_variable_size) (); int (*pl_fd_copy_variable) (); char *(*pl_fd_variable_to_string) (); #else extern void (*pl_fd_init_solver) (); extern void (*pl_fd_reset_solver) (); extern Bool (*pl_fd_unify_with_integer) (); extern Bool (*pl_fd_unify_with_fd_var) (); extern int (*pl_fd_variable_size) (); extern int (*pl_fd_copy_variable) (); extern char *(*pl_fd_variable_to_string) (); #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Fd_Init_Solver(void); void Pl_Fd_Reset_Solver(void); #define Fd_Unify_With_Integer(f, n) ((*pl_fd_unify_with_integer)(f, n)) #define Fd_Unify_With_Fd_Var(f1, f2)((*pl_fd_unify_with_fd_var)(f1, f2)) #define Fd_Variable_Size(f) ((*pl_fd_variable_size)(f)) #define Fd_Copy_Variable(dst_adr, f)((*pl_fd_copy_variable)(dst_adr, f)) #define Fd_Variable_To_String(f) ((*pl_fd_variable_to_string)(f)) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/pred.c�������������������������������������������������������������������0000644�0001750�0001750�00000034270�13021324543�014713� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : pred.c * * Descr.: module/predicate table management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <string.h> #define PRED_FILE #include "engine_pl.h" /* define if CC are added to the predicate table - see pred.c */ #if 1 #define ADD_CONTROL_CONSTRUCTS_IN_PRED_TBL #endif /*---------------------------------* * Constants * *---------------------------------*/ #define ERR_MULTIFILE_PROP "multifile predicate %s/%d not declared consistently\n in %s\n and %s" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /* cache for Pl_Lookup_Module */ static ModuleInf *mod_system; static ModuleInf *mod_user; static int cache_mod_module = -1; static ModuleInf *cache_mod_mod; /* cache for Pl_Lookup_Pred */ static int cache_pred_module = -1; static PlLong cache_pred_f_n; static PredInf *cache_pred_pred; /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_INIT_PRED * * * *-------------------------------------------------------------------------*/ void Pl_Init_Pred(void) { #ifdef ADD_CONTROL_CONSTRUCTS_IN_PRED_TBL int file = Pl_Create_Atom(__FILE__); int prop = MASK_PRED_NATIVE_CODE | MASK_PRED_CONTROL_CONSTRUCT | MASK_PRED_EXPORTED; int meta_arg[3]; /* max is for catch/3 */ #endif pl_module_tbl = Pl_Hash_Alloc_Table(START_MODULE_TBL_SIZE, sizeof(ModuleInf)); mod_system = Pl_Create_Module(pl_atom_system, pl_atom_system); mod_user = Pl_Create_Module(pl_atom_user, pl_atom_user); /* The following control constructs are defined as predicates ONLY to: * * - be found by current_predicate/1 (in system) * - be found by predicate_property/2 * - prevent their redefinition (e.g. asserta/1 will raise a permission_error) * * NB: see ISO Core 1 Section 7.5 about what is a "procedure" * (bult-in predicates, control constructs or user defined predicates). * * Anyway, these predicates should NEVER be called. Ensure it ! * Check the compiler, meta-calls (call/1) and the debugger... */ #ifdef ADD_CONTROL_CONSTRUCTS_IN_PRED_TBL meta_arg[0] = meta_arg[1] = meta_arg[2] = 0; /* default = 0 (integer), e.g. ','(0,0) */ Pl_Create_Pred_Meta(pl_atom_system, ATOM_CHAR(','), 2, file, __LINE__, prop, NULL, meta_arg); Pl_Create_Pred_Meta(pl_atom_system, ATOM_CHAR(';'), 2, file, __LINE__, prop, NULL, meta_arg); Pl_Create_Pred_Meta(pl_atom_system, Pl_Create_Atom("->"), 2, file, __LINE__, prop, NULL, meta_arg); Pl_Create_Pred_Meta(pl_atom_system, Pl_Create_Atom("*->"), 2, file, __LINE__, prop, NULL, meta_arg); Pl_Create_Pred(pl_atom_system, ATOM_CHAR('!'), 0, file, __LINE__, prop, NULL); Pl_Create_Pred(pl_atom_system, Pl_Create_Atom("fail"), 0, file, __LINE__, prop, NULL); Pl_Create_Pred(pl_atom_system, pl_atom_true, 0, file, __LINE__, prop, NULL); Pl_Create_Pred_Meta(pl_atom_system, Pl_Create_Atom("call"), 1, file, __LINE__, prop, NULL, meta_arg); meta_arg[1] = META_PRED_ARG_QUESTION; /* for catch(0,?,0) */ Pl_Create_Pred_Meta(pl_atom_system, Pl_Create_Atom("catch"), 3, file, __LINE__, prop, NULL, meta_arg); Pl_Create_Pred(pl_atom_system, Pl_Create_Atom("throw"), 1, file, __LINE__, prop, NULL); #endif } /*-------------------------------------------------------------------------* * PL_CREATE_MODULE * * * *-------------------------------------------------------------------------*/ ModuleInf * Pl_Create_Module(int module, int pl_file) { ModuleInf module_info; ModuleInf *mod; #ifdef DEBUG DBGPRINTF("Create module: %s\n", pl_atom_tbl[module].name); #endif module_info.module = module; module_info.pl_file = pl_file; module_info.pred_tbl = NULL; Pl_Extend_Table_If_Needed(&pl_module_tbl); mod = (ModuleInf *) Pl_Hash_Insert(pl_module_tbl, (char *) &module_info, FALSE); if (mod->pred_tbl == NULL) mod->pred_tbl = Pl_Hash_Alloc_Table(START_PRED_TBL_SIZE, sizeof(PredInf)); return mod; } /*-------------------------------------------------------------------------* * PL_LOOKUP_MODULE * * * *-------------------------------------------------------------------------*/ ModuleInf * Pl_Lookup_Module(int module) { ModuleInf *mod; if (module == pl_atom_user) return mod_user; if (module == pl_atom_system) return mod_system; if (module == cache_mod_module) return cache_mod_mod; mod = (ModuleInf *) Pl_Hash_Find(pl_module_tbl, module); if (mod == NULL) return NULL; cache_mod_module = module; cache_mod_mod = mod; return mod; } /*-------------------------------------------------------------------------* * PL_DELETE_MODULE * * * *-------------------------------------------------------------------------*/ void Pl_Delete_Module(int module) { Pl_Hash_Delete(pl_module_tbl, module); if (module == cache_mod_module) { cache_mod_module = -1; cache_mod_mod = NULL; } } /*-------------------------------------------------------------------------* * PL_CREATE_PRED * * * * Called by compiled prolog code, by dynamic predicate support and by * * byte-code support. * *-------------------------------------------------------------------------*/ PredInf * FC Pl_Create_Pred(int module, int func, int arity, int pl_file, int pl_line, int prop, CodePtr codep) { ModuleInf *mod = Pl_Create_Module(module, pl_file); PredInf pred_info; PredInf *pred; PlLong f_n = Functor_Arity(func, arity); if (prop & (MASK_PRED_BUILTIN_FD | MASK_PRED_CONTROL_CONSTRUCT)) prop |= MASK_PRED_BUILTIN; /* now an FD built-in or a CC is also a built-in */ if (prop & MASK_PRED_BUILTIN) prop |= MASK_PRED_EXPORTED; #ifdef DEBUG DBGPRINTF("Create pred: %s:%s/%d prop: %x\n", pl_atom_tbl[module].name, pl_atom_tbl[func].name, arity, prop); #endif pred_info.f_n = f_n; pred_info.mod = mod; pred_info.prop = prop; pred_info.pl_file = pl_file; pred_info.pl_line = pl_line; pred_info.meta_spec = 0; pred_info.codep = codep; pred_info.dyn = NULL; Pl_Extend_Table_If_Needed(&mod->pred_tbl); pred = (PredInf *) Pl_Hash_Insert(mod->pred_tbl, (char *) &pred_info, FALSE); if (prop != pred->prop) /* predicate exists - occurs for multifile pred */ { Pl_Fatal_Error(ERR_MULTIFILE_PROP, pl_atom_tbl[func].name, arity, pl_atom_tbl[pred->pl_file].name, pl_atom_tbl[pl_file].name); pred->prop = prop; } #if 1 /* for multifile record the first file where it appears */ pred->pl_file = pl_file; pred->pl_line = pl_line; #endif return pred; } /*-------------------------------------------------------------------------* * PL_CREATE_PRED_META * * * * Called by compiled prolog code, by dynamic predicate support and by * * byte-code support. * *-------------------------------------------------------------------------*/ PredInf * Pl_Create_Pred_Meta(int module, int func, int arity, int pl_file, int pl_line, int prop, CodePtr codep, int meta_arg[]) { PredInf *pred = Pl_Create_Pred(module, func, arity, pl_file, pl_file, prop | MASK_PRED_META_PRED, codep); MetaSpec meta_spec = 0; int i; for(i = 0; i < arity; i++) meta_spec |= (meta_arg[i] << (i * 4)); pred->meta_spec = meta_spec; return pred; } /*-------------------------------------------------------------------------* * LOOKUP_PRED_CACHE * * * *-------------------------------------------------------------------------*/ PredInf * Lookup_Pred_Cache(int module, PlLong f_n) { ModuleInf *mod; PredInf *pred; if (cache_pred_module == module && cache_pred_f_n == f_n) { #if 0 printf("\nCACHED: %s:%s/%d\n", pl_atom_tbl[module].name, pl_atom_tbl[Functor_Of(f_n)].name, (int) Arity_Of(f_n)); #endif return cache_pred_pred; } mod = Pl_Lookup_Module(module); if (mod == NULL) return NULL; pred = (PredInf *) Pl_Hash_Find(mod->pred_tbl, f_n); if (pred == NULL) return NULL; #if 0 printf("\nPUT IN CACHE: %s:%s/%d\n", pl_atom_tbl[module].name, pl_atom_tbl[Functor_Of(f_n)].name, (int) Arity_Of(f_n)); #endif cache_pred_module = module; cache_pred_f_n = f_n; cache_pred_pred = pred; return pred; } /*-------------------------------------------------------------------------* * PL_LOOKUP_PRED * * * *-------------------------------------------------------------------------*/ PredInf * Pl_Lookup_Pred(int module, int func, int arity) { PlLong f_n = Functor_Arity(func, arity); return Lookup_Pred_Cache(module, f_n); } /*-------------------------------------------------------------------------* * PL_LOOKUP_PRED_VISIBLE * * * *-------------------------------------------------------------------------*/ PredInf * Pl_Lookup_Pred_Visible(int module, int func, int arity) { PredInf *pred; PlLong f_n = Functor_Arity(func, arity); if (module != pl_atom_system) { if (module != pl_atom_user) { if ((pred = Lookup_Pred_Cache(module, f_n)) != NULL) return pred; } if ((pred = Lookup_Pred_Cache(pl_atom_user, f_n)) != NULL) return pred; } pred = Lookup_Pred_Cache(pl_atom_system, f_n); return pred; } /*-------------------------------------------------------------------------* * PL_CHECK_SYS_PRED_EXIST * * * *-------------------------------------------------------------------------*/ PredInf * Pl_Check_Sys_Pred_Exist(char *name, int arity) { int func = Pl_Find_Atom(name); PredInf *pred; if (func < 0) /* if the atom does not exist, the pred does not exist neither */ return NULL; pred = Pl_Lookup_Pred(pl_atom_system, func, arity); return pred; } /*-------------------------------------------------------------------------* * PL_DELETE_PRED * * * *-------------------------------------------------------------------------*/ void Pl_Delete_Pred(int module, int func, int arity) { ModuleInf *mod = Pl_Lookup_Module(module); PlLong f_n = Functor_Arity(func, arity); if (mod) { Pl_Hash_Delete(mod->pred_tbl, f_n); if (module == cache_pred_module && f_n == cache_pred_f_n) cache_pred_module = -1; } } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/WIN32_all_SIGSEGV.c������������������������������������������������������0000644�0001750�0001750�00000010070�13021324543�016572� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <signal.h> #include <stdio.h> #include <windows.h> #include <stdint.h> #include <inttypes.h> #if defined(__GNUC__) || defined(__LCC__) typedef enum { ExceptionContinueExecution, ExceptionContinueSearch, ExceptionNestedException, ExceptionCollidedUnwind } EXCEPTION_DISPOSITION; #endif typedef struct _excp_lst { struct _excp_lst *chain; EXCEPTION_DISPOSITION (*handler)(); } excp_lst; #ifdef __GNUC__ # define SEH_PUSH(new_handler) \ { \ excp_lst e; \ e.handler = new_handler; \ asm("movl %%fs:0,%0" : "=r" (e.chain)); \ asm("movl %0,%%fs:0" : : "r" (&e)); # define SEH_POP \ asm("movl %0,%%fs:0" : : "r" (e.chain)); \ } #elif defined(_MSC_VER) # define SEH_PUSH(new_handler) \ { \ excp_lst e; \ e.handler = new_handler; \ __asm push eax \ __asm mov eax,dword ptr fs:[0] \ __asm mov dword ptr [e.chain],eax \ __asm lea eax,[e] \ __asm mov dword ptr fs:[0],eax \ __asm pop eax # define SEH_POP \ __asm push eax \ __asm mov eax,dword ptr [e.chain] \ __asm mov dword ptr fs:[0],eax \ __asm pop eax \ } #elif defined(__LCC__) /* below in movl %eax,%e and movel %e,%eax %e should be %e.chain the lcc asm does not support it. Here %e works since chain is the 1st field */ # define SEH_PUSH(new_handler) \ { \ excp_lst e; \ e.handler = new_handler; \ _asm("pushl %eax"); \ _asm("movl %fs:0,%eax"); \ _asm("movl %eax,%e"); \ _asm("leal %e,%eax"); \ _asm("movl %eax,%fs:0"); \ _asm("popl %eax"); # define SEH_POP \ _asm("pushl %eax"); \ _asm("movl %e,%eax"); \ _asm("movl %eax,%fs:0"); \ _asm("popl %eax"); \ } #else # error macros SEH_PUSH/POP undefined for this compiler #endif PlLong *fault_addr; EXCEPTION_DISPOSITION ExceptionWrapper(EXCEPTION_RECORD *excp_rec, void *establisher_frame, CONTEXT *context_rec, void *dispatcher_cxt) { if (excp_rec->ExceptionFlags) return ExceptionContinueSearch; /* unwind and others */ if (excp_rec->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) fault_addr = (PlLong *) excp_rec->ExceptionInformation[1]; printf("addr:%p\n", fault_addr); /* exit(1); */ return ExceptionContinueSearch; } int SIGSEGV_Handler(int sig) { printf("Segmentation Violation at: %p\n", fault_addr); exit(1); } EXCEPTION_DISPOSITION ExceptionHandler(EXCEPTION_RECORD *excp_rec, void *establisher_frame, CONTEXT *context_rec, void *dispatcher_cxt) { char *addr; DWORD old_prot; if (excp_rec->ExceptionFlags) return ExceptionContinueSearch; /* unwind and others */ if (excp_rec->ExceptionCode != EXCEPTION_ACCESS_VIOLATION) return ExceptionContinueSearch; addr = (char *) excp_rec->ExceptionInformation[1]; printf("access violation at addr:%p - unprotect this page and retry\n", addr); if (!VirtualProtect(addr, 4096, PAGE_READWRITE, &old_prot)) { printf("In Handler VirtualProtect failed: %" PL_FMT_u "\n", GetLastError()); return ExceptionContinueSearch; } return ExceptionContinueExecution; } int bar=1; int main() { #if 0 PlLong *x; SEH_PUSH(ExceptionWrapper); signal(SIGSEGV, (void (*)(int)) SIGSEGV_Handler); x = (PlLong *) 0xffff040; *x = 12 / bar; /* set bar to 1 to test div by 0 exception */ SEH_POP; #else char *addr; int page_size, i; DWORD old_prot; page_size = 4096; addr = (char *) VirtualAlloc(0, 8192, MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE); if (addr == NULL) { printf("VirtualAlloc failed : %" PL_FMT_u "\n", GetLastError()); return 1; } if (!VirtualProtect(addr + 4096, page_size, PAGE_NOACCESS, &old_prot)) { printf("VirtualProtect failed : %" PL_FMT_u "\n", GetLastError()); return 1; } SEH_PUSH(ExceptionHandler); printf("One page allocated at:%p no access at: %p\n", addr, addr + 4096); for(i = 0; i < 8192; i++) addr[i] = i & 0x7f; printf("seem OK, checking...\n"); for(i = 0; i < 8192; i++) if (addr[i] != (i & 0x7f)) { printf("ERROR AT %p\n", addr + i); return 1; } printf("OK !\n"); SEH_POP; #endif return 0; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/machine1.h���������������������������������������������������������������0000644�0001750�0001750�00000007764�13021324543�015463� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine + Compiler * * File : machine1.h * * Descr.: machine dependent features - Header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> /*---------------------------------* * Constants * *---------------------------------*/ #define M_OS_UNIX 0 #define M_OS_WINDOWS 1 #define M_OS_WINDOWS_NT 2 #define M_ERROR_WIN32 -2 /* read GetLastError instead of errno */ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef MACHINE1_FILE int pl_m_os_type; char pl_m_architecture[32]; char pl_m_os_version[256]; #else extern int pl_m_os_type; extern char pl_m_architecture[]; extern char pl_m_os_version[]; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Init_Machine1(void); char **Pl_M_Create_Shell_Command(char *cmd); char **Pl_M_Cmd_Line_To_Argv(char *cmd, int *argc); int Pl_M_Shell(char *cmd); int Pl_M_Spawn(char *arg[]); int Pl_M_Spawn_Redirect(char *arg[], int detach, FILE **f_in, FILE **f_out, FILE **f_err); int Pl_M_Get_Status(int pid); char *Pl_M_Mktemp(char *tmp_template); char *Pl_M_Tempnam(char *dir, char *pfx); #define DBGPRINTF printf ������������gprolog-1.4.5/src/EnginePl/stacks_sigsegv.c���������������������������������������������������������0000644�0001750�0001750�00000050243�13021324543�016776� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : stacks_sigsegv.c * * Descr.: stack hardware overflow detection (SIGSEGV) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /* copy this from try_sigaction.c */ #if defined(M_ix86_sco) #define _XOPEN_SOURCE 700 #define _XOPEN_SOURCE_EXTENDED #endif #include <stdio.h> #include <stdlib.h> #include <signal.h> #include <errno.h> #include <fcntl.h> #include <ctype.h> #include <string.h> #include <time.h> #include <sys/types.h> #include <sys/stat.h> #include "gp_config.h" /* ensure __unix__ defined if not Win32 */ #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #elif defined(_WIN32) #include <windows.h> #endif #include "engine_pl.h" /* see configure.in */ #if !defined(HAVE_WORKING_SIGACTION) && defined(LINUX_NEEDS_ASM_SIGCONTEXT) #include <asm/sigcontext.h> #endif #ifdef HAVE_SYS_SIGINFO_H #include <sys/siginfo.h> #endif #if defined(HAVE_MMAP) && !defined(_WIN32) #include <sys/mman.h> #if !defined(MAP_ANON) && defined(MAP_ANONYMOUS) #define MAP_ANON MAP_ANONYMOUS #endif #endif #if 0 #define DEBUG #endif /*---------------------------------* * Constants * *---------------------------------*/ #define M_MAGIC1 0x12345678 #define M_MAGIC2 0xdeadbeef #define MAX_SIGSEGV_HANDLER 10 /* Error Messages */ #define ERR_STACKS_ALLOCATION "Memory allocation fault" #define ERR_CANNOT_OPEN_DEV0 "Cannot open /dev/zero : %s" #define ERR_CANNOT_UNMAP "unmap failed : %s" #define ERR_CANNOT_FREE "VirtualFree failed : %" PL_FMT_u #define ERR_CANNOT_PROTECT "VirtualProtect failed : %" PL_FMT_u #define ERR_STACK_OVERFLOW_ENV "%s stack overflow (size: %d Kb, reached: %d Kb, environment variable used: %s)" #define ERR_STACK_OVERFLOW_NO_ENV "%s stack overflow (size: %d Kb, reached: %d Kb - fixed size)" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int page_size; static SegvHdlr tbl_handler[MAX_SIGSEGV_HANDLER]; static int nb_handler = 0; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Install_SIGSEGV_Handler(void); static void SIGSEGV_Handler(); static void Handle_Bad_Address(void *bad_addr); static int Default_SIGSEGV_Handler(void *bad_addr); static char *Stack_Overflow_Err_Msg(int stk_nb); #define Round_Up(x, y) (((x) + (y) - 1) / (y) * (y)) #define Round_Down(x, y) ((x) / (y) * (y)) #if defined(_WIN32) /*-------------------------------------------------------------------------* * GETPAGESIZE * * * *-------------------------------------------------------------------------*/ int getpagesize(void) { SYSTEM_INFO si; GetSystemInfo(&si); return si.dwPageSize; } #endif /*-------------------------------------------------------------------------* * VIRTUAL_MEM_ALLOC * * * *-------------------------------------------------------------------------*/ static void * Virtual_Mem_Alloc(void *addr, int length) { #if defined(_WIN32) addr = (void *) VirtualAlloc(addr, length, MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE); #elif defined(HAVE_MMAP) #ifndef MAP_ANON static int fd = -1; if (fd == -1) fd = open("/dev/zero", 0); if (fd == -1) Pl_Fatal_Error(ERR_CANNOT_OPEN_DEV0, Pl_M_Sys_Err_String(-1)); #endif /* !MAP_ANON */ addr = (void *) mmap((void *) addr, length, PROT_READ | PROT_WRITE, MAP_PRIVATE #ifdef MMAP_NEEDS_FIXED | MAP_FIXED #endif #ifdef MAP_ANON | MAP_ANON, -1, #else , fd, #endif /* !MAP_ANON */ 0); if (addr == (void *) -1) addr = NULL; #else /* !HAVE_MMAP */ addr = (void *) Calloc(length, 1); #endif /* !HAVE_MMAP */ return addr; } #if TAG_SIZE_HIGH > 0 /*-------------------------------------------------------------------------* * VIRTUAL_MEM_FREE * * * *-------------------------------------------------------------------------*/ static void Virtual_Mem_Free(void *addr, int length) { #if defined(_WIN32) if (!VirtualFree(addr, 0, MEM_RELEASE)) Pl_Fatal_Error(ERR_CANNOT_FREE, GetLastError()); #elif defined(HAVE_MMAP) if (munmap((void *) addr, length) == -1) Pl_Fatal_Error(ERR_CANNOT_UNMAP, Pl_M_Sys_Err_String(-1)); #else Free(addr); #endif } #endif /* TAG_SIZE_HIGH > 0 */ /*-------------------------------------------------------------------------* * VIRTUAL_MEM_PROTECT * * * *-------------------------------------------------------------------------*/ static void Virtual_Mem_Protect(void *addr, int length) { WamWord *end = (WamWord *) addr; #if defined(_WIN32) DWORD old_prot; if (!VirtualProtect(addr, length, PAGE_NOACCESS, &old_prot)) Pl_Fatal_Error(ERR_CANNOT_PROTECT, GetLastError()); #elif defined(HAVE_MMAP) # ifdef HAVE_MPROTECT if (mprotect((void *) addr, length, PROT_NONE) == -1) # endif if (munmap((void *) addr, length) == -1) Pl_Fatal_Error(ERR_CANNOT_UNMAP, Pl_M_Sys_Err_String(-1)); #endif end[-16] = M_MAGIC1; end[-32] = M_MAGIC2; /* and rest (end[-1,...]) should be 0 */ end[-33] = 0; } /*-------------------------------------------------------------------------* * PL_ALLOCATE_STACKS * * * *-------------------------------------------------------------------------*/ void Pl_Allocate_Stacks(void) { unsigned length = 0, stk_sz; WamWord *addr; int i; WamWord *addr_to_try[] = { #ifndef MMAP_NEEDS_FIXED NULL, #endif #ifdef M_MMAP_HIGH_ADR1 (WamWord *) M_MMAP_HIGH_ADR1, #endif #ifdef M_MMAP_HIGH_ADR2 (WamWord *) M_MMAP_HIGH_ADR2, #endif #ifdef M_MMAP_HIGH_ADR3 (WamWord *) M_MMAP_HIGH_ADR3, #endif (WamWord *) -1 }; page_size = getpagesize() / sizeof(WamWord); for (i = 0; i < NB_OF_STACKS; i++) { stk_sz = pl_stk_tbl[i].size = Round_Up(pl_stk_tbl[i].size, page_size); if (stk_sz == 0) stk_sz = page_size; /* at leat one page to write magic numbers */ length += stk_sz + page_size; } length *= sizeof(WamWord); addr = NULL; for(i = 0; addr == NULL && addr_to_try[i] != (WamWord *) -1; i++) { addr = addr_to_try[i]; #ifdef DEBUG DBGPRINTF("trying at high addr: %p --> ", addr); #endif if (addr) { addr = (WamWord *) Round_Down((PlULong) addr, getpagesize()); addr = (WamWord *) ((PlULong) (addr) - length); } #ifdef DEBUG DBGPRINTF("base: %p length: %d Kb\n", addr, length / 1024); #endif addr = Virtual_Mem_Alloc(addr, length); #ifdef DEBUG DBGPRINTF("obtaining: %p (end: %p)\n", addr, (WamWord *) ((PlULong) addr + length)); #endif #if TAG_SIZE_HIGH > 0 if (addr && (((PlULong) (addr) + length) >> (WORD_SIZE - TAG_SIZE_HIGH)) != 0) { #ifdef DEBUG DBGPRINTF(" -> invalid high bits addr\n"); #endif Virtual_Mem_Free(addr, length); addr = NULL; } #endif /* TAG_SIZE_HIGH > 0 */ } if (addr == NULL) Pl_Fatal_Error(ERR_STACKS_ALLOCATION); for (i = 0; i < NB_OF_STACKS; i++) { pl_stk_tbl[i].stack = addr; stk_sz = pl_stk_tbl[i].size; if (stk_sz == 0) stk_sz = page_size; /* at least one page for magic numbers */ #ifdef DEBUG DBGPRINTF(" stack: %d %-10s length: %5ld Kb addr:[%p..%p[ + 1 free page, next addr: %p\n", i, pl_stk_tbl[i].name, stk_sz * sizeof(WamWord) / 1024, addr, addr + stk_sz, addr + stk_sz + page_size); #endif addr += stk_sz; Virtual_Mem_Protect(addr, page_size * sizeof(WamWord)); addr += page_size; } Install_SIGSEGV_Handler(); /* install the real (and unique) SIGSEGV handler */ Pl_Push_SIGSEGV_Handler(Default_SIGSEGV_Handler); /* install initial user SIGSEGV handler */ } #if defined(__unix__) || defined(__CYGWIN__)|| defined(_WIN64) /*-------------------------------------------------------------------------* * SIGSEGV_HANDLER * * * *-------------------------------------------------------------------------*/ #if defined(HAVE_WORKING_SIGACTION) || \ defined(M_sparc_solaris) || defined(M_ix86_solaris) || defined(M_x86_64_solaris) static void SIGSEGV_Handler(int sig, siginfo_t *sip) { void *addr = (void *) sip->si_addr; Handle_Bad_Address(addr); } #elif defined(M_sparc_sunos) static void SIGSEGV_Handler(int sig, int code, int scp, void *addr) { Handle_Bad_Address(addr); } #elif defined(M_alpha_osf) static void SIGSEGV_Handler(int sig, int code, struct sigcontext *scp) { void *addr = (void *) (scp->sc_traparg_a0); Handle_Bad_Address(addr); } #elif defined(M_alpha_linux) static void SIGSEGV_Handler(int sig, struct sigcontext scp) { void *addr = (void *) (scp.sc_fp_trigger_inst); /* why this one? */ /* void *addr=(void *) (scp.sc_traparg_a0); */ Handle_Bad_Address(addr); } #elif defined(M_ix86_linux) static void SIGSEGV_Handler(int sig, struct sigcontext scp) { void *addr = (void *) scp.cr2; Handle_Bad_Address(addr); } #elif defined(M_powerpc_linux) static void SIGSEGV_Handler(int sig, struct sigcontext scp) { void *addr = (void *) scp.regs->dar; Handle_Bad_Address(addr); } #elif defined(M_ix86_sco) #include <sys/siginfo.h> static void SIGSEGV_Handler(int sig, siginfo_t * si) { void *addr = (void *) si->si_addr; Handle_Bad_Address(addr); } #elif defined(M_ix86_bsd) || defined(M_powerpc_bsd) || defined(M_sparc_bsd) || defined(M_sparc64_bsd) static void SIGSEGV_Handler(int sig, int code, struct sigcontext *scp) { void *addr = (void *) scp->sc_err; Handle_Bad_Address(addr); } #elif defined(M_x86_64_linux) || defined(M_x86_64_bsd) || defined(M_x86_64_darwin) static void SIGSEGV_Handler(int sig, siginfo_t *sip, void *scp) { void *addr = (void *) sip->si_addr; Handle_Bad_Address(addr); } #elif defined(M_mips_irix) static void SIGSEGV_Handler(int sig, int code, struct sigcontext *scp) { void *addr = scp->sc_regs[16]; Handle_Bad_Address(addr); } #else static void SIGSEGV_Handler(int sig) /* cannot detect fault addr */ { #ifdef __GNUC__ #warning SIGSEGV_Handler does not know how to detect fault addr - use magic numbers #endif #define M_USE_MAGIC_NB_TO_DETECT_STACK_NAME Handle_Bad_Address(NULL); } #endif #else /* WINDOWS */ /*-------------------------------------------------------------------------* * WIN32_EXCEPTION_HANDLER * * * *-------------------------------------------------------------------------*/ static LONG WINAPI Win32_Exception_Handler(LPEXCEPTION_POINTERS ei) { void *addr; switch(ei->ExceptionRecord->ExceptionCode) { case EXCEPTION_ACCESS_VIOLATION: /* Windows SIGSEGV */ case STATUS_STACK_OVERFLOW: addr = (void *) ei->ExceptionRecord->ExceptionInformation[1]; Handle_Bad_Address(addr); break; #ifdef DEBUG default: printf("UNKNOWN exception\n"); break; #endif } return EXCEPTION_EXECUTE_HANDLER; } #endif /* WINDOWS */ /*-------------------------------------------------------------------------* * INSTALL_SIGSEGV_HANDLER * * * *-------------------------------------------------------------------------*/ static void Install_SIGSEGV_Handler(void) { #if defined(HAVE_WORKING_SIGACTION) || \ defined(M_sparc_solaris) || defined(M_ix86_solaris) || \ defined(M_ix86_sco) || defined(M_x86_64_solaris) struct sigaction act; act.sa_sigaction = (void (*)()) SIGSEGV_Handler; sigemptyset(&act.sa_mask); act.sa_flags = SA_SIGINFO | SA_RESTART; sigaction(SIGSEGV, &act, NULL); # if defined(SIGBUS) && SIGBUS != SIGSEGV sigaction(SIGBUS, &act, NULL); # endif #elif defined(_WIN32) && !defined(_WIN64) SetUnhandledExceptionFilter(Win32_Exception_Handler); #else signal(SIGSEGV, (void (*)(int)) SIGSEGV_Handler); #endif } /*-------------------------------------------------------------------------* * HANDLE_BAD_ADDRESS * * * *-------------------------------------------------------------------------*/ static void Handle_Bad_Address(void *bad_addr) { int i = nb_handler; while(--i >= 0) { if ((*tbl_handler[i])(bad_addr)) return; } Pl_Fatal_Error("Segmentation Violation at: %p", bad_addr); exit(1); } /*-------------------------------------------------------------------------* * PL_PUSH_SIGSEGV_HANDLER * * * *-------------------------------------------------------------------------*/ void Pl_Push_SIGSEGV_Handler(SegvHdlr handler) { if (nb_handler >= MAX_SIGSEGV_HANDLER) Pl_Fatal_Error("too many SIGSEGV handlers (max: %d)", MAX_SIGSEGV_HANDLER); tbl_handler[nb_handler++] = handler; } /*-------------------------------------------------------------------------* * PL_POP_SIGSEGV_HANDLER * * * *-------------------------------------------------------------------------*/ void Pl_Pop_SIGSEGV_Handler(void) { if (nb_handler > 0) nb_handler--; } /*-------------------------------------------------------------------------* * DEFAULT_SIGSEGV_HANDLER * * * *-------------------------------------------------------------------------*/ static int Default_SIGSEGV_Handler(void *bad_addr) { #ifdef M_USE_MAGIC_NB_TO_DETECT_STACK_NAME M_Check_Magic_Words(); Pl_Fatal_Error("Segmentation Violation"); #else /* !M_USE_MAGIC_NB_TO_DETECT_STACK_NAME */ int i; WamWord *addr = (WamWord *) bad_addr; #ifdef DEBUG DBGPRINTF("BAD ADDRESS:%p \n", addr); #endif i = NB_OF_STACKS - 1; if (addr < pl_stk_tbl[i].stack + pl_stk_tbl[i].size + page_size) while (i >= 0) { #ifdef DEBUG DBGPRINTF("STACK[%d].stack + size: %p\n", i, pl_stk_tbl[i].stack + pl_stk_tbl[i].size); #endif if (addr >= pl_stk_tbl[i].stack + pl_stk_tbl[i].size) { #ifdef DEBUG DBGPRINTF("Found overflow on stack[%d]\n", i); #endif Pl_Fatal_Error(Stack_Overflow_Err_Msg(i)); } i--; } Pl_Fatal_Error("Segmentation Violation (bad address: %p)", addr); #endif /* !M_USE_MAGIC_NB_TO_DETECT_STACK_NAME */ return 1; /* treated, anyway this handler never returns (exit()) */ } #ifdef M_USE_MAGIC_NB_TO_DETECT_STACK_NAME #ifndef NO_USE_LINEDIT #include "../Linedit/linedit.h" #endif /*-------------------------------------------------------------------------* * M_CHECK_MAGIC_WORDS * * * *-------------------------------------------------------------------------*/ void M_Check_Magic_Words(void) { int i, err = 0; WamWord *end, *top; char *msg; char *sever; for (i = 0; i < NB_OF_STACKS; i++) { if (pl_stk_tbl[i].size == 0) continue; end = pl_stk_tbl[i].stack + pl_stk_tbl[i].size; top = Stack_Top(i); #ifdef DEBUG DBGPRINTF("stack: %s start: %p end: %p top: %p\n", pl_stk_tbl[i].name, pl_stk_tbl[i].stack, end, top); #endif sever = NULL; if (end[-16] != M_MAGIC1 || end[-32] != M_MAGIC2 || end[-33] != 0) sever = "Probable Error"; else if (top < pl_stk_tbl[i].stack || top >= end) sever = "Possible Error"; if (sever) { err++; msg = Stack_Overflow_Err_Msg(i); #ifndef NO_USE_LINEDIT if (pl_le_hook_message_box) (*pl_le_hook_message_box)(sever, msg, 0); else #endif fprintf(stderr, "%s: %s\n", sever, msg); } } if (err) Pl_Exit_With_Value(1); } #endif /*-------------------------------------------------------------------------* * STACK_OVERFLOW_ERR_MSG * * * *-------------------------------------------------------------------------*/ static char * Stack_Overflow_Err_Msg(int stk_nb) { InfStack *s = pl_stk_tbl + stk_nb; char *var = s->env_var_name; int size = s->size; int usage = Stack_Top(stk_nb) - s->stack; static char msg[256]; if (s->stack == Global_Stack) size += REG_BANK_SIZE; /* see Init_Engine */ size = Wam_Words_To_KBytes(size); usage = Wam_Words_To_KBytes(usage); if (pl_fixed_sizes || var[0] == '\0') sprintf(msg, ERR_STACK_OVERFLOW_NO_ENV, s->name, size, usage); else sprintf(msg, ERR_STACK_OVERFLOW_ENV, s->name, size, usage, var); return msg; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/pl_params.h��������������������������������������������������������������0000644�0001750�0001750�00000006442�13021324543�015744� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : pl_params.h * * Descr.: parameter header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define MAX_OBJECT 1024 #define START_MODULE_TBL_SIZE 32 #define START_PRED_TBL_SIZE 4096 #define START_OPER_TBL_SIZE 1024 #define ENV_VAR_MAX_ATOM "MAX_ATOM" #define DEFAULT_MAX_ATOM 32768 #define NB_OF_X_REGS 256 #define MAX_ARITY (NB_OF_X_REGS - 1) /* NB: if NB_OF_X_REGS is changed it is necessary to modify ma2asm but also the byte code management */ #define PROLOG_FILE_SUFFIX ".pl" #define PROLOG_FILE_SUFFIXES_ALT "|.pro|.prolog|" #if 0 #define META_TERM_HIDDEN #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/set_locale.h�������������������������������������������������������������0000644�0001750�0001750�00000006001�13021324543�016067� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : configuration * * File : set_locale.h * * Descr.: localization management - Header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _SET_LOCALE_H #define _SET_LOCALE_H #include <locale.h> /* static or inline (or macro) since the DLL uses it (avoid link) */ static void Set_Locale(void) { setlocale(LC_ALL, ""); setlocale(LC_NUMERIC, "C"); /* make sure floats come out right... */ } #endif /* !_SET_LOCALE_H */ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/WIN32_SIGSEGV.c����������������������������������������������������������0000644�0001750�0001750�00000003214�13021324543�015744� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #include <windows.h> #include <stdint.h> #include <inttypes.h> int getpagesize(void) { SYSTEM_INFO si; GetSystemInfo(&si); return si.dwPageSize; } PlLong *fault_addr; int Is_Win32_SEGV(LPEXCEPTION_POINTERS err) { PEXCEPTION_RECORD per = err->ExceptionRecord; if (per->ExceptionCode != EXCEPTION_ACCESS_VIOLATION) return EXCEPTION_CONTINUE_SEARCH; fault_addr = (PlLong *) (per->ExceptionInformation[1]); return EXCEPTION_EXECUTE_HANDLER; } main(int argc, char *argv[]) { PlLong *addr = NULL; int i; DWORD old_prot; setbuf(stdout, NULL); printf("Page Size:%d bytes\n", getpagesize()); if (argc > 1) addr = (PlLong *) _strtoul(argv[1], NULL, 16); printf("TRYING at %#x\n", addr); addr = VirtualAlloc(addr, 4096 * 2, MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE); if (addr == NULL) { printf("ERROR Alloc %" PL_FMT_u "\n", GetLastError()); exit(1); } if (!VirtualProtect(addr + 1024, 4096, PAGE_NOACCESS, &old_prot)) { printf("ERROR protect %" PL_FMT_u "\n", GetLastError()); exit(1); } printf("ALLOC at %#x\n", addr); _try { PlLong *a = (PlLong *) 0x12345678; *a = 12; } _except(Is_Win32_SEGV(GetExceptionInformation())) { printf("ACCESS VIOLATION at addr=%#x\n", fault_addr); } _try { for (i = 0; i < 1025; i++) addr[i] = i; for (i = 0; i < 1024; i++) if (addr[i] != i) printf("ERROR at [%d]=%d\n", i, addr[i]); } _except(Is_Win32_SEGV(GetExceptionInformation())) { printf("ACCESS VIOLATION at [%d] addr=%#x (%#x)\n", i, fault_addr, addr + i); } printf("FINISHED\n"); } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/engine1.c����������������������������������������������������������������0000644�0001750�0001750�00000015236�13021324543�015310� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : engine1.c * * Descr.: general engine * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" WamWord *pl_ensure_reserved; #if !(defined(M_x86_64) && defined(_MSC_VER))/* see file eng1-x86_64_win.s */ /*-------------------------------------------------------------------------* * Call_Compiled invokes a Prolog code. * * reserved_stack_space is only used to reserve some space in the stack and* * should not be removed by the compiler. This allows prolog compiled code * * to use this space to pass the arguments to C run-time functions, without* * having to decrement $sp (ie. push/pop) (e.g. on ix86). * * Note finally that since this function is called inside Call_Next, we are* * sure that $sp at longjmp will be more recent (ie. <) than $sp at setjmp.* * Certain implementations of setjmp/longjmp requires this. * * * * Warning: do not use nested { ... } blocs to declare register variables * * The C compiler "forgets" them after the bloc (e.g. solaris 2.6). * * * * This functions is in a separate file for historical reasons. In versions* * <= 1.2.4, this file was compiled without any C compiler optimization to * * ensure reserved_stack_space was not removed by the C compiler. In order * * to use ebp under ix86 it must be compiled with -fomit-frame-pointer. The* * simpliest way was to use the same C compiler invocation but adding a * * global variable to ensure the stack is not removed. * *-------------------------------------------------------------------------*/ void Pl_Call_Compiled(CodePtr codep) { WamWord reserved_stack_space[1024]; /* check why not sparc_bsd ? */ #if (defined(M_sparc) && !defined(M_sparc_bsd)) || defined(M_sparc64) register PlLong * __attribute__ ((unused)) rfl asm("%l2") = pl_base_fl; register double * __attribute__ ((unused)) rfd asm("%l3") = pl_base_fd; pl_ensure_reserved = (WamWord *) rfl + (PlLong) rfd; /* to avoid gcc remove 2 previous inits ! */ #endif #if !defined(NO_MACHINE_REG_FOR_REG_BANK) && !defined(MAP_REG_BANK) #if defined(M_ix86_linux) || \ defined(M_ix86_cygwin) || defined(M_ix86_mingw) || \ defined(M_ix86_sco) || defined(M_ix86_bsd) register WamWord *rb asm("%ebx") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #elif defined(_MSC_VER) && defined(M_ix86) _asm mov ebx, pl_reg_bank #elif defined(M_mips_irix) register WamWord *rb asm("$16") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #elif defined(M_alpha_linux) || defined(M_alpha_osf) register WamWord *rb asm("$9") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #elif defined(M_powerpc_linux) register WamWord *rb asm("15") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #elif defined(M_powerpc_darwin) register WamWord *rb asm("r15") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #elif defined(M_sparc) || defined(M_sparc64) register WamWord *rb asm("%l0") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #elif defined(M_x86_64_darwin) register WamWord *rb asm("%r12") = pl_reg_bank; pl_ensure_reserved = (WamWord *) rb; /* to avoid gcc warning */ #ifdef __llvm__ /* the above does not assign r12 now by Apple gcc = llvm clang */ asm("movq _pl_reg_bank@GOTPCREL(%rip), %r12"); asm("movq (%r12), %r12"); #endif #endif #endif /* !defined(NO_MACHINE_REG_FOR_REG_BANK) && !defined(MAP_REG_BANK) */ pl_ensure_reserved = reserved_stack_space; #if defined(M_ix86_darwin) /* see comment in Ma2Asm/ix86_any.c */ asm("andl $0xfffffff0,%esp"); asm("addl $4,%esp"); #elif defined(M_x86_64) && !defined(_MSC_VER) /* see comment in Ma2Asm/x86_64_any.c */ asm("andq $0xfffffffffffffff0,%rsp"); asm("addq $8,%rsp"); #endif (*codep) (); } #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/Makefile.in��������������������������������������������������������������0000644�0001750�0001750�00000006142�13021324543�015657� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ROOT_DIR1 = @ROOT_DIR1@ LIB_ENGINE_PL = @LIB_ENGINE_PL@ GPLC = @GPLC@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ AR_RC = @AR_RC@ RANLIB = @RANLIB@ LIBNAME = $(LIB_ENGINE_PL) OBJLIB = machine@OBJ_SUFFIX@ machine1@OBJ_SUFFIX@ stacks_sigsegv@OBJ_SUFFIX@ mem_alloc@OBJ_SUFFIX@ \ misc@OBJ_SUFFIX@ hash_fct@OBJ_SUFFIX@ hash@OBJ_SUFFIX@ obj_chain@OBJ_SUFFIX@ \ engine@OBJ_SUFFIX@ engine1@OBJ_SUFFIX@ wam_inst@OBJ_SUFFIX@ \ atom@OBJ_SUFFIX@ pred@OBJ_SUFFIX@ oper@OBJ_SUFFIX@ \ if_no_fd@OBJ_SUFFIX@ main@OBJ_SUFFIX@ all: config wam_regs.h cpp_headers@EXE_SUFFIX@ $(LIBNAME) $(LIBNAME): $(OBJLIB) rm -f $(LIBNAME) $(AR_RC)@AR_SEP@$(LIBNAME) $(OBJLIB) $(RANLIB) $(LIBNAME) .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .c $(SUFFIXES) .c@OBJ_SUFFIX@: $(GPLC) -c -C '$(CFLAGS)' $*.c # Configuration config: pl_config@EXE_SUFFIX@ wam_regs.h pl_config@EXE_SUFFIX@: pl_config.c gp_config.h machine.h stacks_sigsegv.h wam_archi.def $(CC) $(CFLAGS) $(LFLAGS) @CC_EXE_NAME_OPT@pl_config@EXE_SUFFIX@ pl_config.c wam_regs.h: pl_config@EXE_SUFFIX@ machine.h stacks_sigsegv.h wam_archi.def ./pl_config@EXE_SUFFIX@ (cd ../TopComp; $(MAKE) $(GPLC)@EXE_SUFFIX@) gp_config.h: echo '*** run ./configure before make please ***' exit 1 cpp_headers@EXE_SUFFIX@: cpp_headers.c $(CC) $(CFLAGS) $(LFLAGS) @CC_EXE_NAME_OPT@cpp_headers@EXE_SUFFIX@ cpp_headers.c try_sigaction@EXE_SUFFIX@: try_sigaction.c $(CC) $(CFLAGS) $(LFLAGS) @CC_EXE_NAME_OPT@try_sigaction@EXE_SUFFIX@ try_sigaction.c # General core machine@OBJ_SUFFIX@: machine.h machine.c gp_config.h wam_regs.h stacks_sigsegv@OBJ_SUFFIX@: stacks_sigsegv.h stacks_sigsegv.c gp_config.h wam_regs.h mem_alloc@OBJ_SUFFIX@: mem_alloc.c misc@OBJ_SUFFIX@: misc.h misc.c machine.h hash@OBJ_SUFFIX@: hash.h hash.c main@OBJ_SUFFIX@: main.c obj_chain@OBJ_SUFFIX@: obj_chain.h obj_chain.c # Prolog engine # engine1.c should be compiled without optimizations (or else it is a .s) engine1@OBJ_SUFFIX@: @MAKE_ENGINE1_SRC@ $(GPLC) -c -o engine1@OBJ_SUFFIX@ @MAKE_ENGINE1_SRC@ engine@OBJ_SUFFIX@: engine.h engine.c wam_inst@OBJ_SUFFIX@: wam_archi.h wam_inst.h wam_inst.c unify.c hash_fct@OBJ_SUFFIX@: hash_fct.h hash_fct1.c atom@OBJ_SUFFIX@: atom.h atom.c gp_config.h pred@OBJ_SUFFIX@: pred.h pred.c oper@OBJ_SUFFIX@: oper.h oper.c if_no_fd@OBJ_SUFFIX@: if_no_fd.h if_no_fd.c clean: rm -f pl_config@EXE_SUFFIX@ cpp_headers@EXE_SUFFIX@ try_sigaction@EXE_SUFFIX@ *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp $(LIBNAME) distclean: clean clean-test_oc rm -f wam_archi.h wam_regs.h gp_config.h check: test_oc@EXE_SUFFIX@ ./test_oc@EXE_SUFFIX@ clean-check: clean-test_oc # test obj chain utility TEST_OC_SRC=obj_chain.c test_oc.c test_oc@EXE_SUFFIX@: obj_chain.c obj_chain.h test_oc.c test_oc_defs.h for i in 1 2 3 4 5; do \ (echo "#define OBJ_NO $$i" && \ echo "#include \"test_oc_defs.h\"") >test_oc_m$$i.c || exit; \ done $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@test_oc@EXE_SUFFIX@ test_oc.c obj_chain.c -I. test_oc_m[1-5].c rm -f test_oc_m* test_oc*@OBJ_SUFFIX@ clean-test_oc: rm -f test_oc@EXE_SUFFIX@ test_oc_m* ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/engine.c�����������������������������������������������������������������0000644�0001750�0001750�00000043027�13021324543�015226� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : engine.c * * Descr.: general engine * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <setjmp.h> #include "gp_config.h" #include "set_locale.h" #if defined(_WIN32) || defined(__CYGWIN__) #include <windows.h> #define READ_REGISTRY_ONLY #include "../TopComp/prolog_path.c" #else #include <sys/param.h> #endif #define ENGINE_FILE #include "engine_pl.h" #ifndef NO_USE_LINEDIT #include "../Linedit/linedit.h" #endif #include "../TopComp/prolog_path.c" /*---------------------------------* * Constants * *---------------------------------*/ #define ERR_DIRECTIVE_FAILED "warning: %s:%d: %s directive failed\n" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ void (*pl_init_stream_supp)(); /* overwritten by foreign if present */ #if !defined(NO_USE_REGS) && NB_OF_USED_MACHINE_REGS > 0 static WamWord init_buff_regs[NB_OF_USED_MACHINE_REGS]; #endif static WamWord *heap_actual_start; static int nb_user_directives = 0; static sigjmp_buf *p_jumper; static WamWord *p_buff_save; static CodePtr cont_jmp; /* we use a global var to support DEC alpha */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Call_Prolog_Fail(void); static void Call_Prolog_Success(void); static Bool Call_Next(CodePtr codep); void Pl_Call_Compiled(CodePtr codep); /* defined in engine1.c */ /*-------------------------------------------------------------------------* * PL_START_PROLOG * * * *-------------------------------------------------------------------------*/ int Pl_Start_Prolog(int argc, char *argv[]) { int i, x; char *p; void (*copy_of_pl_init_stream_supp)() = Pl_Dummy_Ptr(pl_init_stream_supp); #if defined(_WIN32) || defined(__CYGWIN__) DWORD y; #endif Set_Locale(); pl_os_argc = argc; pl_os_argv = argv; pl_home = Get_Prolog_Path(argv[0], &pl_devel_mode); Pl_Init_Machine(); Set_Line_Buf(stdout); Set_Line_Buf(stderr); for (i = 0; i < NB_OF_STACKS; i++) { if (pl_fd_init_solver == NULL && strcmp(pl_stk_tbl[i].name, "cstr") == 0) { /* FD solver not linked */ pl_stk_tbl[i].size = 0; continue; } if ((pl_stk_tbl[i].size = KBytes_To_Wam_Words(*(pl_stk_tbl[i].p_def_size))) == 0) pl_stk_tbl[i].size = pl_stk_tbl[i].default_size; if (!pl_fixed_sizes && *pl_stk_tbl[i].env_var_name) { p = (char *) getenv(pl_stk_tbl[i].env_var_name); if (p && *p) { sscanf(p, "%d", &x); pl_stk_tbl[i].size = KBytes_To_Wam_Words(x); } #if defined(_WIN32) || defined(__CYGWIN__) if (Read_Windows_Registry(pl_stk_tbl[i].env_var_name, REG_DWORD, &y, sizeof(x))) pl_stk_tbl[i].size = KBytes_To_Wam_Words(y); #endif } } /* similar treatment for max_atom */ if ((pl_max_atom = pl_def_max_atom) == 0) pl_max_atom = DEFAULT_MAX_ATOM; if (!pl_fixed_sizes) { p = (char *) getenv(ENV_VAR_MAX_ATOM); if (p && *p) { sscanf(p, "%d", &x); pl_max_atom = x; } #if defined(_WIN32) || defined(__CYGWIN__) if (Read_Windows_Registry(ENV_VAR_MAX_ATOM, REG_DWORD, &y, sizeof(x))) pl_max_atom = y; #endif } Pl_Allocate_Stacks(); Save_Machine_Regs(init_buff_regs); #ifndef NO_MACHINE_REG_FOR_REG_BANK Init_Reg_Bank(Global_Stack); /* allocated X regs + other non alloc regs */ Global_Stack += REG_BANK_SIZE; /* at the beginning of the heap */ Global_Size -= REG_BANK_SIZE; #endif /* must be changed to store global info (see the debugger) */ heap_actual_start = Global_Stack; Pl_Init_Atom(); Pl_Init_Pred(); Pl_Init_Oper(); pl_le_mode = 0; /* not compiled with linedit or deactivated (using env var) */ #ifndef NO_USE_LINEDIT if (pl_le_initialize != NULL) pl_le_mode = (*pl_le_initialize)(); #endif if (copy_of_pl_init_stream_supp) (*copy_of_pl_init_stream_supp)(); Pl_Reset_Prolog(); Pl_Fd_Init_Solver(); Pl_Find_Linked_Objects(); return nb_user_directives; } /*-------------------------------------------------------------------------* * PL_STOP_PROLOG * * * *-------------------------------------------------------------------------*/ void Pl_Stop_Prolog(void) { #ifdef DEREF_STATS double d = (double) chain_len / (double) nb_deref; fprintf(stderr, "Deref: nb: %" PL_FMT_d " avg len = %g\n", nb_deref, d); #endif Restore_Machine_Regs(init_buff_regs); } /*-------------------------------------------------------------------------* * PL_RESET_PROLOG * * * * Reset top stack pointers and create first choice point (for Call_Prolog)* *-------------------------------------------------------------------------*/ void Pl_Reset_Prolog(void) { E = B = LSSA = Local_Stack; H = heap_actual_start; /* restart after needed global terms */ TR = Trail_Stack; CP = NULL; STAMP = 0; CS = Cstr_Stack; BCI = 0; /* BCI only needed for byte-code (cf. bips prolog) */ Pl_Create_Choice_Point(Call_Prolog_Fail, 0); /* 1st choice point */ Pl_Fd_Reset_Solver(); } /*-------------------------------------------------------------------------* * PL_RESET_PROLOG_IN_SIGNAL * * * *-------------------------------------------------------------------------*/ void Pl_Reset_Prolog_In_Signal(void) { Restore_Protect_Regs_For_Signal; } /*-------------------------------------------------------------------------* * PL_SET_HEAP_ACTUAL_START * * * * Called to store permanent terms (cf. debugger). * *-------------------------------------------------------------------------*/ void Pl_Set_Heap_Actual_Start(WamWord *new_heap_actual_start) { heap_actual_start = new_heap_actual_start; } /*-------------------------------------------------------------------------* * PL_EXECUTE_DIRECTIVE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void Pl_Execute_Directive(int pl_file, int pl_line, Bool is_system, CodePtr codep) { Pl_Reset_Prolog(); if (!is_system) nb_user_directives++; if (!Pl_Call_Prolog(codep)) fprintf(stderr, ERR_DIRECTIVE_FAILED, pl_atom_tbl[pl_file].name, pl_line, (is_system) ? "system" : "user"); Pl_Reset_Prolog(); } /*-------------------------------------------------------------------------* * PL_TRY_EXECUTE_TOP_LEVEL * * * *-------------------------------------------------------------------------*/ Bool Pl_Try_Execute_Top_Level(void) { PredInf *pred; Pl_Reset_Prolog(); pred = Pl_Lookup_Pred(pl_atom_system, Pl_Create_Atom("top_level"), 0); if (pred != NULL) { Pl_Call_Prolog(pred->codep); return TRUE; } Pl_Reset_Prolog(); return FALSE; } /*-------------------------------------------------------------------------* * PL_CALL_PROLOG * * * * Call_Prolog runs the execution of one prolog goal. * * The current choice point is updated to set ALTB to Call_Prolog_Fail and * * CP is set to Call_Prolog_Success. At the end ALTB and CP are restored. * * To ensure that a choice point always exists before invoking Call_Prolog,* * Start_Prolog reserve the space for a feint choice point, i.e ALTB can be* * safely modified. * * * * Call_Prolog returns TRUE if the predicate has succeed, FALSE otherwise. * * The called predicate can be non-deterministic. * *-------------------------------------------------------------------------*/ Bool Pl_Call_Prolog(CodePtr codep) { WamWord *query_b = B; WamCont save_CP = CP; WamCont save_ALTB = ALTB(query_b); Bool ok; ALTB(query_b) = (WamCont) Call_Prolog_Fail; /* modify choice point */ CP = Adjust_CP(Call_Prolog_Success); ok = Call_Next(codep); CP = save_CP; /* restore continuation */ ALTB(query_b) = save_ALTB; /* restore choice point */ return ok; } /*-------------------------------------------------------------------------* * PL_CALL_PROLOG_NEXT_SOL * * * * Call_Prolog_Next_Sol bactracks over the next solution. * *-------------------------------------------------------------------------*/ Bool Pl_Call_Prolog_Next_Sol(WamWord *query_b) { WamCont save_CP = CP; WamCont save_ALTB = ALTB(query_b); Bool ok; ALTB(query_b) = (WamCont) Call_Prolog_Fail; /* modify choice point */ CP = Adjust_CP(Call_Prolog_Success); /* should be useless since */ /* alternative will restore CP */ ok = Call_Next(ALTB(B)); CP = save_CP; /* restore continuation */ ALTB(query_b) = save_ALTB; /* restore choice point */ return ok; } /*-------------------------------------------------------------------------* * PL_KEEP_REST_FOR_PROLOG * * * * Update CP in choices points to be used by classical Prolog engine * * (some CPB(b) have been set to Call_Prolog_Success due to Call_Prolog). * *-------------------------------------------------------------------------*/ void Pl_Keep_Rest_For_Prolog(WamWord *query_b) { WamWord *b, *e, *query_e; for (b = B; b > query_b; b = BB(b)) if (CPB(b) == Adjust_CP(Call_Prolog_Success)) CPB(b) = CP; query_e = EB(query_b); for (e = EB(B); e > query_e; e = EE(e)) if (CPE(e) == Adjust_CP(Call_Prolog_Success)) CPE(e) = CP; } /*-------------------------------------------------------------------------* * CALL_NEXT * * * * Call_Next saves the context with setjmp. Since Call_Prolog can be nested* * we handle a stack of jumpers (i.e. contexts) directely in the C stack. * * The global variables p_jumper is the top of the stack and points to the * * current jumper. Similarly for the stack of machine register save buffers* *-------------------------------------------------------------------------*/ static Bool Call_Next(CodePtr codep) { int jmp_val; sigjmp_buf *old_jumper = p_jumper; sigjmp_buf new_jumper; WamWord *old_buff_save = p_buff_save; WamWord buff_save_machine_regs[NB_OF_USED_MACHINE_REGS + 1]; /* +1 if = 0 */ #if 0 WamWord buff_save_all_regs[NB_OF_REGS]; #endif p_jumper = &new_jumper; p_buff_save = buff_save_machine_regs; #if 0 Save_All_Regs(buff_save_all_regs); #endif Save_Machine_Regs(buff_save_machine_regs); jmp_val = sigsetjmp(*p_jumper, 1); Restore_Machine_Regs(buff_save_machine_regs); if (jmp_val == 0) /* normal call to codep */ Pl_Call_Compiled(codep); if (jmp_val == 3) /* return with a continuation in jmp_val */ Pl_Call_Compiled(cont_jmp); /* normal return */ p_jumper = old_jumper; p_buff_save = old_buff_save; if (jmp_val < 0) /* false: restore WAM registers */ { #if 0 Restore_All_Regs(buff_save_all_regs); #endif return FALSE; } return jmp_val; /* 1 (TRUE) or 3 (exception) */ } /*------------------------------------------------------------* * Call_Prolog_Fail: Prolog continuation after failure. * * Return in Call_Next with a longjmp (value -1) * *------------------------------------------------------------*/ #if 1/*!(defined(M_x86_64) && defined(_MSC_VER))*//* see file engine_asm.s */ static void Call_Prolog_Fail(void) { #ifdef M_ix86_darwin /* see comment in Ma2Asm/ix86_any.c */ asm("subl $4,%esp"); #elif defined(M_x86_64) && !defined(_MSC_VER) /* see comment in Ma2Asm/x86_64_any.c */ asm("subq $8,%rsp"); #endif Save_Machine_Regs(p_buff_save); siglongjmp(*p_jumper, -1); } /*------------------------------------------------------------* * Call_Prolog_Success: Prolog continuation after success. * * Return in Call_Next with a longjmp (value 1) * *------------------------------------------------------------*/ static void Call_Prolog_Success(void) { #ifdef M_ix86_darwin /* see comment in Ma2Asm/ix86_any.c */ asm("subl $4,%esp"); #elif defined(M_x86_64) && !defined(_MSC_VER) /* see comment in Ma2Asm/x86_64_any.c */ asm("subq $8,%rsp"); #endif Save_Machine_Regs(p_buff_save); siglongjmp(*p_jumper, 1); } #endif /*------------------------------------------------------------* * Exit_With_Exception: * * Similar to a success but Call_Prolog returns 2 instead of 1* * (i.e. TRUE) * * Return in Call_Next with a longjmp (value 2) * *------------------------------------------------------------*/ void Pl_Exit_With_Exception(void) { Save_Machine_Regs(p_buff_save); siglongjmp(*p_jumper, 2); } /*------------------------------------------------------------* * Execute_A_Continuation: * * Similar to a nested Call_Prolog but faster, and if a fail * * occurs it is normally handled by the prolog engine, i.e. * * the last choice point is reconsidered. * * Return in Call_Next with a longjmp (value 3 cont_jmp=codep)* *------------------------------------------------------------*/ void Pl_Execute_A_Continuation(CodePtr codep) { Save_Machine_Regs(p_buff_save); cont_jmp = codep; siglongjmp(*p_jumper, 3); } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/cpt_string.c�������������������������������������������������������������0000644�0001750�0001750�00000061106�13021324543�016133� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Common tool * * File : cpt_string.c * * Descr.: (longest) common prefix tree management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #if 1 #define USE_ALONE #endif #ifdef USE_ALONE #define Malloc(size) malloc(size) #define Calloc(nb, size) calloc(nb, size) #define Realloc(ptr, size) realloc(ptr, size) #define Free(ptr) free(ptr) #else #include "engine_pl.h" #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct cptnode *CPTTree; typedef struct cptcell *CPTList; typedef struct cptcell { CPTTree tree; CPTList next; } CPTCell; typedef struct cptnode { char *str; int length; int end; CPTList list; } CPTNode; typedef CPTTree CPT; typedef struct { CPTTree tree; char *buff; int length; int (*fct) (); } CPTMatch; typedef struct { int nb_word; int nb_node; int nb_node2; int nb_branch; int max_branch_size; int sum_branch_size_word; int sum_branch_size; int max_word_length; int sum_word_length; int max_swrd_length; int fst_list_size; int max_list_size; int max2_list_size; int sum_list_size; } CPTStat; /*---------------------------------* * Global Variables * *---------------------------------*/ static CPTMatch match; static CPTStat stat; /*---------------------------------* * Function Prototypes * *---------------------------------*/ CPT CPT_Init(void); int CPT_Add_Word(CPT cpt, char *word, int length); static int Common_Prefix_Length(char *str1, int l1, char *str2, int l2); static CPTTree Create_Node(char *word, int length, int end, CPTList list); static CPTList Create_Cell(CPTTree tree, CPTList next); int CPT_Search_Word(CPT tree, char *word, int length); CPTMatch *CPT_Init_Match(CPT tree, char *prefix, int prefix_length, char *buff, int (*fct) ()); int CPT_Do_Match(CPTMatch *match); static int Do_Match_Rec(CPTTree tree, char *buff, int length, int (*fct) (), int no, int *cont); char *CPT_Match_Info(CPTMatch *match, int *prefix_length, int *nb_words, int *max_length); static int Match_Info_Rec(CPTTree tree, int length, int *max_length); CPTStat *CPT_Statistics(CPT tree); static void Statistics_Rec(CPT tree, int depth, int prefix_length); /*-------------------------------------------------------------------------* * CPT_INIT * * * *-------------------------------------------------------------------------*/ CPT CPT_Init(void) { /* to ensure initial tree is never NULL */ return Create_Node(NULL, 0, 0, NULL); } /*-------------------------------------------------------------------------* * CPT_ADD_WORD * * * *-------------------------------------------------------------------------*/ int CPT_Add_Word(CPT tree, char *word, int length) { int l; CPTTree *ptree, tree1; CPTList *p; for (;;) { l = Common_Prefix_Length(word, length, tree->str, tree->length); if (l == length && l == tree->length) { /* both the word and the prefix are fully consumed */ word_consumed: if (tree->end) return 1; tree->end = 1; return 0; } word += l; length -= l; if (l < tree->length) /* the stored prefix is not fully consumed */ { /* update the stored prefix: */ /* create a node with begin and a son with end */ tree1 = Create_Node(tree->str, l, 0, Create_Cell(tree, NULL)); tree->str += l; tree->length -= l; *ptree = tree = tree1; } if (length == 0) /* the word is fully consumed */ goto word_consumed; /* create a node for the rest of the word */ tree1 = Create_Node(word, length, 1, NULL); /* find the appropriate son in the sorted list */ for (p = &(tree->list); *p && (*p)->tree->str[0] < *word; p = &((*p)->next)) ; /* no existing son - create a new cell */ if (*p == NULL || (*p)->tree->str[0] > *word) { *p = Create_Cell(tree1, *p); return 0; } /* an existing entry matches */ ptree = &((*p)->tree); tree = *ptree; } } /*-------------------------------------------------------------------------* * COMMON_PREFIX_LENGTH * * * *-------------------------------------------------------------------------*/ static int Common_Prefix_Length(char *str1, int l1, char *str2, int l2) { if (l1 < l2) /* l2 is the min of l1 and l2 */ l2 = l1; l1 = 0; while (l1 < l2 && *str1 == *str2) { str1++; str2++; l1++; } return l1; } /*-------------------------------------------------------------------------* * CREATE_NODE * * * *-------------------------------------------------------------------------*/ static CPTTree Create_Node(char *word, int length, int end, CPTList list) { CPTTree tree = (CPTTree) Malloc(sizeof(CPTNode)); tree->str = word; tree->length = length; tree->end = end; tree->list = list; return tree; } /*-------------------------------------------------------------------------* * CREATE_CELL * * * *-------------------------------------------------------------------------*/ static CPTList Create_Cell(CPTTree tree, CPTList next) { CPTList list = (CPTList) Malloc(sizeof(CPTCell)); list->tree = tree; list->next = next; return list; } /*-------------------------------------------------------------------------* * CPT_REMOVE_WORD * * * *-------------------------------------------------------------------------*/ int CPT_Remove_Word(CPTTree tree, char *word, int length) { CPTList *p0, *p, list; int l; if (length == 0) /* do not free first node - i.e. empty word */ { if (!tree->end) return 0; tree->end = 0; return 1; } p = p0 = NULL; for (;;) { if (length < tree->length || memcmp(word, tree->str, tree->length) != 0) return 0; word += tree->length; length -= tree->length; if (length == 0) { if (!tree->end) return 0; if (tree->list) /* at least 1 son */ tree->end = 0; else { /* no son */ Free(tree); list = *p; *p = list->next; Free(list); if (p0 == NULL) return 1; p = p0; /* tree is the parent tree */ tree = (*p)->tree; } if (tree->list && tree->list->next == NULL && !tree->end) { /* only 1 son - collapse */ l = tree->length; (*p)->tree = tree->list->tree; Free(tree); tree = (*p)->tree; tree->str -= l; tree->length += l; } return 1; } p0 = p; for (p = &(tree->list); *p && (*p)->tree->str[0] < *word; p = &((*p)->next)) ; if (*p == NULL || (*p)->tree->str[0] != *word) return 0; /* an existing entry matches */ tree = (*p)->tree; } } /*-------------------------------------------------------------------------* * CPT_SEARCH_WORD * * * *-------------------------------------------------------------------------*/ int CPT_Search_Word(CPT tree, char *word, int length) { CPTList list; for (;;) { if (length < tree->length || memcmp(word, tree->str, tree->length) != 0) return 0; word += tree->length; length -= tree->length; if (length == 0) return tree->end; for (list = tree->list; list && list->tree->str[0] < *word; list = list->next) ; if (list == NULL || list->tree->str[0] != *word) return 0; tree = list->tree; } } /*-------------------------------------------------------------------------* * CPT_GENSYM * * * *-------------------------------------------------------------------------*/ int CPT_Gensym(CPTTree tree, char *prefix, int prefix_length, char *buff) #if 1 #define GENSYM_CHARS "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" #else #define GENSYM_CHARS "abc" #endif { CPTList list; int c; char *save_buff; static char gensym_chars[] = GENSYM_CHARS; if (buff != prefix) { memcpy(buff, prefix, prefix_length); prefix = buff; } save_buff = buff; buff += prefix_length; #if 1 c = rand() % (sizeof(gensym_chars) - 1); *buff++ = gensym_chars[c]; prefix_length++; #endif for (;;) { if (prefix_length < tree->length || memcmp(prefix, tree->str, tree->length) != 0) { prefix_is_ok: *buff = '\0'; return buff - save_buff; } if (prefix_length == tree->length) { if (!tree->end) goto prefix_is_ok; c = rand() % (sizeof(gensym_chars) - 1); *buff++ = gensym_chars[c]; prefix_length++; } prefix += tree->length; prefix_length -= tree->length; for (list = tree->list; list && list->tree->str[0] < *prefix; list = list->next) ; if (list == NULL || list->tree->str[0] != *prefix) goto prefix_is_ok; tree = list->tree; } } /*-------------------------------------------------------------------------* * CPT_INIT_MATCH * * * *-------------------------------------------------------------------------*/ CPTMatch * CPT_Init_Match(CPTTree tree, char *prefix, int prefix_length, char *buff, int (*fct) ()) { CPTList list; int l; match.buff = buff; for (;;) { l = Common_Prefix_Length(prefix, prefix_length, tree->str, tree->length); if (l == prefix_length) { match.tree = tree; memcpy(buff, tree->str, tree->length); buff += tree->length; *buff = '\0'; match.length = buff - match.buff; match.fct = fct; return &match; } if (l < tree->length) return NULL; prefix += l; prefix_length -= l; for (list = tree->list; list && list->tree->str[0] < *prefix; list = list->next) ; if (list == NULL || list->tree->str[0] != *prefix) return NULL; memcpy(buff, tree->str, tree->length); buff += tree->length; tree = list->tree; } } /*-------------------------------------------------------------------------* * CPT_DO_MATCH * * * *-------------------------------------------------------------------------*/ int CPT_Do_Match(CPTMatch *match) { CPTTree tree = match->tree; int cont = 1; if (tree == NULL) /* should not occur */ return 0; return Do_Match_Rec(tree, match->buff, match->length, match->fct, 0, &cont); } /*-------------------------------------------------------------------------* * DO_MATCH_REC * * * *-------------------------------------------------------------------------*/ static int Do_Match_Rec(CPTTree tree, char *buff, int length, int (*fct) (), int no, int *cont) { CPTList list; char *p = buff + length; if (tree->end) { *cont = (*fct) (buff, length, no); no++; } for (list = tree->list; *cont && list; list = list->next) { tree = list->tree; memcpy(p, tree->str, tree->length); p[tree->length] = '\0'; no = Do_Match_Rec(tree, buff, length + tree->length, fct, no, cont); } return no; } /*-------------------------------------------------------------------------* * CPT_MATCH_INFO * * * *-------------------------------------------------------------------------*/ char * CPT_Match_Info(CPTMatch *match, int *prefix_length, int *nb_words, int *max_length) { CPTTree tree = match->tree; if (tree == NULL) return NULL; *prefix_length = match->length; *max_length = 0; *nb_words = Match_Info_Rec(tree, match->length, max_length); return match->buff; } /*-------------------------------------------------------------------------* * MATCH_INFO_REC * * * *-------------------------------------------------------------------------*/ static int Match_Info_Rec(CPTTree tree, int length, int *max_length) { int nb_word = 0; CPTList list; if (tree->end) { nb_word = 1; if (length > *max_length) *max_length = length; } else nb_word = 0; for (list = tree->list; list; list = list->next) { tree = list->tree; nb_word += Match_Info_Rec(tree, length + tree->length, max_length); } return nb_word; } /*-------------------------------------------------------------------------* * CPT_STATISTICS * * * *-------------------------------------------------------------------------*/ CPTStat * CPT_Statistics(CPT tree) { memset((void *) &stat, 0, sizeof(CPTStat)); Statistics_Rec(tree, 0, 0); return &stat; } /*-------------------------------------------------------------------------* * STATISTICS_REC * * * *-------------------------------------------------------------------------*/ static void Statistics_Rec(CPT tree, int depth, int length) { int n; CPTList list; stat.nb_node++; depth++; if (depth > stat.max_branch_size) stat.max_branch_size = depth; length += tree->length; if (tree->list && tree->length > stat.max_swrd_length) stat.max_swrd_length = tree->length; if (tree->end) { stat.sum_branch_size_word += depth; stat.nb_word++; stat.sum_word_length += length; if (length > stat.max_word_length) stat.max_word_length = length; } for (n = 0, list = tree->list; list; list = list->next, n++) Statistics_Rec(list->tree, depth, length); if (n == 0) { stat.nb_branch++; stat.sum_branch_size += depth; } else stat.nb_node2++; if (depth == 1) stat.fst_list_size = n; stat.sum_list_size += n; if (n > stat.max_list_size) stat.max_list_size = n; if (depth > 1 && n > stat.max2_list_size) stat.max2_list_size = n; } #ifdef USE_ALONE #define BUFF_SIZE 1024 void Show_Words(CPT tree); void Show_Words_Rec(CPT tree, char *prefix, int length); void Show_Tree(CPT tree, int level); int Display_Completion(char *str, int length, int no); int Read_String(FILE *f, char *str); /*-------------------------------------------------------------------------* * SHOW_TREE * * * *-------------------------------------------------------------------------*/ void Show_Tree(CPT tree, int level) { CPTList list; printf("%*s<%.*s> %s\n", level, "", tree->length, tree->str, (tree->end) ? "X" : ""); for (list = tree->list; list; list = list->next) Show_Tree(list->tree, level + 3); } /*-------------------------------------------------------------------------* * SHOW_WORDS * * * *-------------------------------------------------------------------------*/ void Show_Words(CPT tree) { char buff[BUFF_SIZE]; Show_Words_Rec(tree, buff, 0); } /*-------------------------------------------------------------------------* * SHOW_WORDS_REC * * * *-------------------------------------------------------------------------*/ void Show_Words_Rec(CPT tree, char *prefix, int length) { CPTList list; memcpy(prefix + length, tree->str, tree->length); length += tree->length; if (tree->end) printf("%.*s\n", length, prefix); for (list = tree->list; list; list = list->next) Show_Words_Rec(list->tree, prefix, length); } /*-------------------------------------------------------------------------* * DISPLAY_COMPLETION * * * *-------------------------------------------------------------------------*/ int Display_Completion(char *str, int length, int no) { printf("match %6d :<%s> len=%d\n", no, str, length); #if 0 return no < 5 - 1 #else return 1; #endif } /*-------------------------------------------------------------------------* * READ_STRING * * * *-------------------------------------------------------------------------*/ int Read_String(FILE *f, char *str) { int l; if (fgets(str, BUFF_SIZE, f) == NULL) return -1; l = strlen(str) - 1; /* remove trailing '\n' */ str[l] = '\0'; return l; } /*-------------------------------------------------------------------------* * MAIN * * * * to compile alone active USE_ALONE and simply compile this file. * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { CPT cpt; CPTMatch *match; CPTStat *stat; int c, l, n, m; char str[BUFF_SIZE]; char buff[BUFF_SIZE]; FILE *f; setbuf(stdout, NULL); /* for MS VC++ compiler */ cpt = CPT_Init(); if (argc > 1 && (f = fopen(argv[1], "rt")) != NULL) { int n = 0; int d = 0; int length = 0; printf("adding words from file: %s\n", argv[1]); while ((l = Read_String(f, str)) >= 0) { d += CPT_Add_Word(cpt, strdup(str), l); n++; length += l; } fclose(f); printf("Added %d words-%d duplicates=%d - sum length=%d\n", n, d, n - d, length); } for (;;) { printf("1-Add 2-Remove 3-Search 4-Completion 5-GenSym\n"); printf("6-Words 7-Tree 8-Stats 9-end: "); scanf("%d", &c); getchar(); if (c == 9) break; switch (c) { case 1: printf("word: "); l = Read_String(stdin, str); if (CPT_Add_Word(cpt, strdup(str), l)) printf("already inserted\n"); break; case 2: printf("word: "); l = Read_String(stdin, str); if (!CPT_Remove_Word(cpt, str, l)) printf("does not exist\n"); break; case 3: printf("word: "); l = Read_String(stdin, str); if (CPT_Search_Word(cpt, str, l)) printf("found\n"); else printf("not found\n"); break; case 4: printf("prefix: "); l = Read_String(stdin, str); if ( (match = CPT_Init_Match(cpt, str, l, buff, Display_Completion))) { CPT_Match_Info(match, &l, &n, &m); printf("longest prefix:<%s> length=%d" " nb words=%d longest word=%d\n", buff, l, n, m); printf("Nb displayed:%d\n", CPT_Do_Match(match)); } else printf("No matching\n"); break; case 5: printf("prefix: "); l = Read_String(stdin, str); l = CPT_Gensym(cpt, str, l, buff); printf("new symbol:<%s> length=%d\n", buff, l); if (CPT_Add_Word(cpt, strdup(buff), l)) printf("ERROR - %s already inserted\n", buff); break; case 6: Show_Words(cpt); break; case 7: Show_Tree(cpt, 0); break; case 8: stat = CPT_Statistics(cpt); printf("\nGeneral\n"); printf("nb words = %d\n", stat->nb_word); printf("nb nodes = %d\n", stat->nb_node); printf("nb nodes prefix = %d\n", stat->nb_node2); printf("nb branches = %d\n", stat->nb_branch); printf("\nBanch sizes\n"); printf("longest = %d\n", stat->max_branch_size); printf("sum sizes = %d\n", stat->sum_branch_size); printf("avg size = %g\n", (double) stat->sum_branch_size / stat->nb_branch); printf("sum size / word = %d\n", stat->sum_branch_size_word); printf("avg size / word = %g\n", (double) stat->sum_branch_size_word / stat->nb_word); printf("\nWord lengths\n"); printf("longest = %d\n", stat->max_word_length); printf("longest sub-word= %d\n", stat->max_swrd_length); printf("sum lengths = %d\n", stat->sum_word_length); printf("avg length = %g\n", (double) stat->sum_word_length / stat->nb_word); printf("\nList sizes\n"); printf("longest = %d\n", stat->max_list_size); printf("sum sizes = %d\n", stat->sum_list_size); printf("avg size = %g\n", (double) stat->sum_list_size / stat->nb_node2); printf("first list size = %d\n", stat->fst_list_size); printf(" excepting first list (ie. first node):\n"); printf("longest = %d\n", stat->max2_list_size); printf("sum' sizes = %d\n", stat->sum_list_size - stat->fst_list_size); printf("avg' size = %g\n", (double) (stat->sum_list_size - stat->fst_list_size) / (stat->nb_node2 - 1)); break; } } return 0; } #endif /* USE_ALONE */ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EnginePl/stacks_sigsegv.h���������������������������������������������������������0000644�0001750�0001750�00000006613�13021324543�017005� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog engine * * File : stacks_sigsegv.c * * Descr.: stack hardware overflow detection (SIGSEGV) - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _STACKS_SIGSEGV #define _STACKS_SIGSEGV /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef int (*SegvHdlr)(void *bad_addr); /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Allocate_Stacks(void); void Pl_Push_SIGSEGV_Handler(SegvHdlr handler); void Pl_Pop_SIGSEGV_Handler(void); #endif /* !_STACKS_SIGSEGV */ ���������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/�����������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�012630� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/FD_SYNTAX��������������������������������������������������������������������0000644�0001750�0001750�00000003620�13021324543�014147� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������user_cstr::= head body head::= c_ident '(' decl... ')' decl::= type var ',' type::= int | fdv | any | l_int | l_fdv | l_any body::= bloc_lst wait_swt wait_swt::= 'wait_switch' case... | empty case::= 'case' cond stop... bloc... stop::= 'stop' c_ident bloc_lst::= bloc... | empty bloc::= foreach 'start' bloc_name elem... forall last_elem trig always foreach::= 'foreach' var 'in' var 'do' | empty bloc_name::= '(' c_ident ')' | empty elem::= type var type = int / range | 'fail' 'if' cond | 'exit' 'if' cond | var '=' term type = int | var '=' range type = range | empty forall::= 'forall' var 'in' var 'do' | empty last_elem::= x_in_r | c_fct x_in_r::= var 'in' range range::= term '..' term | '{' term,... '}' | var type = range | 'dom' '(' var ')' type = fdv | range ':' range | range '&' range | '~' range | range '++' range | range '--' range | range '**' range | range '//' range | range '%%' range | range '+' term | range '-' term | range '*' term | range '/' term | range '%' term | c_fct trig::= 'trigger' [ 'also' ] 'on' trig_elem... | empty trig_elem::= 'min' '(' var ')' type = fdv / l_fdv | 'max' '(' var ')' type = fdv / l_fdv | 'val' '(' var ')' type = fdv / l_fdv | 'dom' '(' var ')' type = fdv / l_fdv always::= 'always' | empty cond::= term term::= integer | 'max_integer' | var type = int | 'min' '(' var ')' type = fdv | 'max' '(' var ')' type = fdv | 'val' '(' var ')' type = fdv | term '+' term | term '-' term | term '*' term | term '/<' term | term '/>' term | term 'mod' term | other C expressions (using &&, ||, ==, !=, <, <=, >, >=) | c_fct type::= 'int' | 'range' | 'fdv' | 'any' | 'l_fdv' | 'l_int' 'l_any' c_fct::= c_ident '(' arg... ')' arg::= term | range | var type = all | '&' arg c_ident::= [A-Z][a-zA-Z_0-9]* cannot be a keyword ����������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/.gitignore�������������������������������������������������������������������0000644�0001750�0001750�00000000031�13021324543�014606� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile fd2c *.wam INST �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/read_file.pl�����������������������������������������������������������������0000644�0001750�0001750�00000013070�13021324543�015074� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint definition file to C code compiler * * File : read_file.pl * * Descr.: source file reading * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ file_to_token_lst(LToken) :- get_code(stream_fd, C), file_to_token_lst1(C, LToken). file_to_token_lst1(-1, []) :- !. file_to_token_lst1(C, LToken) :- C =< 32, !, get_code(stream_fd, C1), file_to_token_lst1(C1, LToken). file_to_token_lst1(47, LToken) :- peek_code(stream_fd, 42), !, get_code(stream_fd, _), skip_until(42, 47, f), get_code(stream_fd, C1), file_to_token_lst1(C1, LToken). file_to_token_lst1(37, LToken) :- peek_code(stream_fd, 123), !, get_code(stream_fd, _), stream_line_column(stream_fd, Line1, _), format(stream_c, '~n/* line:~d begin included code */~n', [Line1]), skip_until(37, 125, t), stream_line_column(stream_fd, Line2, _), format(stream_c, '~n/* line:~d end included code */~n', [Line2]), get_code(stream_fd, C1), file_to_token_lst1(C1, LToken). file_to_token_lst1(C, [t(Token, Line, Col1)|LToken]) :- stream_line_column(stream_fd, Line, Col), Col1 is Col - 1, one_token(C, Token, C1), file_to_token_lst1(C1, LToken). skip_until(C1, C2, Echo) :- g_assign(next, C1), repeat, g_read(next, Next), get_code(stream_fd, C), skip1(C, Next, C1, C2, Echo), !. skip1(-1, _, C1, C2, _) :- error('EOF reached before ~c~c found', [C1, C2]). skip1(Next, Next, _, Next, _) :- !. skip1(Next, Next, Next, C2, _) :- !, g_assign(next, C2), fail. skip1(C, Next, C1, Next, Echo) :- !, ( Echo = t -> put_code(stream_c, C1), put_code(stream_c, C) ; true ), g_assign(next, C1), fail. skip1(C, _, _, _, Echo) :- ( Echo = t -> put_code(stream_c, C) ; true ), fail. one_token(C, Token, C2) :- ( C >= 97, C =< 122, C1 = C ; C >= 65, C =< 90, C1 is C + 97 - 65 ; C = 39, C1 = C ), !, unget_code(stream_fd, C1), read_atom(stream_fd, Token1), ( C >= 65, C =< 90 -> sub_atom(Token1, 1, _, 0, A), char_code(AC, C), atom_concat(AC, A, Token2) ; Token2 = Token1 ), ( keyword(Token2) -> Token = Token2 ; Token = ident(Token2) ), get_code(stream_fd, C2). one_token(C, Token, C1) :- C >= 48, C =< 57, !, unget_code(stream_fd, C), read_integer(stream_fd, Token), get_code(stream_fd, C1). one_token(C, Token, C2) :- get_code(stream_fd, C1), char_code(A1, C), char_code(A2, C1), atom_concat(A1, A2, A), ( member(A, [/<, />, ==, '!=', <=, >=, &&, '||', .., ++, --, **, //, '%%', '|<', '|>']) -> get_code(stream_fd, C2), Token = A ; Token = A1, C2 = C1 ). keyword(min). keyword(max). keyword(dom). keyword(val). keyword(int). keyword(range). keyword(fdv). keyword(any). keyword(l_int). keyword(l_range). keyword(l_fdv). keyword(l_any). keyword(when). keyword(wait_switch). keyword(case). keyword(start). keyword(trigger). keyword(also). keyword(on). keyword(always). keyword(fail). keyword(exit). keyword(if). keyword(stop). keyword(forall). keyword(foreach). keyword(do). keyword(in). keyword(max_integer). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/compile.pl�������������������������������������������������������������������0000644�0001750�0001750�00000041765�13021324543�014626� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint definition file to C code compiler * * File : compile.pl * * Descr.: final compilation and emission * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ % to correctly write C expressions :- op(750, yfx, [&&, '||']). :- op(700, xfx, [==, '!=', <=]). :- op(400, yfx, [/<, />, '%']). :- op(300, fy, [&]). emit_code_init(FdFile) :- absolute_file_name(FdFile, FdFile1), format(stream_c, '/* C file generated for ~w */~n~n', [FdFile1]), format(stream_c, '#include "fd_to_c.h"~n', []). emit_user_cstr(uc(Name, AFSize, LHVar, Body)) :- g_assign(name, Name), g_assign(bloc, 1), atom_length(Name, X), X1 is X + 19, format(stream_c, '~n\t/*~*c*/~n', [X1, 45]), format(stream_c, '\t/* User constraint: ~a */~n', [Name]), format(stream_c, '\t/*~*c*/~n', [X1, 45]), e_body(Body, LFctName), format(stream_c, '~n~n\t/* Entry point for ~a */~n', [Name]), format(stream_c, '~nfd_begin_user_constraint(~a', [Name]), e_head_vars(LHVar, '('), format(stream_c, '))~n~n', []), format(stream_c, ' fd_create_a_frame(~d)~n', [AFSize]), e_load_env(LHVar), nl(stream_c), format(stream_c, ' fd_before_add_constraint~n', []), e_call_fct_lst(LFctName), format(stream_c, ' fd_exit_point~n', []), format(stream_c, ' fd_after_add_constraint~n', []), format(stream_c, ' fd_return~n', []), format(stream_c, '~nfd_end_user_constraint~n~n', []). e_head_vars([], _). e_head_vars([v(V, _, _)|LHVar], Car) :- format(stream_c, '~aFdArg(~a)', [Car, V]), e_head_vars(LHVar, ','). e_load_env([]). e_load_env([v(V, T, I)|LHVar]) :- format(stream_c, ' fd_~a_in_a_frame(~a,~d)~n', [T, V, I]), e_load_env(LHVar). e_call_fct_lst([]). e_call_fct_lst([FctName|LFctName]) :- e_call_internal(FctName, f), e_call_fct_lst(LFctName). e_call_internal(FctName, CallerHasCFrame) :- ( sub_atom(FctName, _, _, _, '_switch_') -> ( CallerHasCFrame = t -> Inst = fd_call_internal_and_test_switch ; Inst = fd_call_internal_and_test_switch_simple ) ; Inst = fd_call_internal ), format(stream_c, ' ~a(~a)~n', [Inst, FctName]). e_body(by(LBloc, WaitSwt), LFctName1) :- e_bloc_lst(LBloc, LFctName), ( WaitSwt = ws(LUse, LCase) -> e_wait_swt(LUse, LCase, FctName1), e_fct_install_triggers(-1, LUse, -1, always, FctName1, FctName), append(LFctName, [FctName], LFctName1) ; LFctName1 = LFctName ). e_wait_swt(LUse, LCase, FctName) :- e_case_lst(LCase, 1, LFctName0), internal_fct_name(switch, 1, FctName), e_bloc_load_use(LUse, LCVarUsed, LWInst1, LWInst), e_test_case_lst(LCase, LFctName0, LWInst1), alloc_and_emit_fct_code(FctName, LCVarUsed, LWInst, t). e_case_lst([], _, []). e_case_lst([ca(_, LBNoStop, LBloc)|LCase], I, [FctName|LFctName]) :- e_bloc_lst(LBloc, LFctName0), ( LFctName0 = [FctName], LBNoStop = [] -> true ; e_case_group(LFctName0, LBNoStop, I, FctName) ), I1 is I + 1, e_case_lst(LCase, I1, LFctName). e_case_group(LFctName, LBNoStop, I, FctName) :- internal_fct_name(case_group, I, FctName), format(stream_c, '~n~n\t/* Group of case #~d */~n', [I]), format(stream_c, '~nfd_begin_internal(~a)~n~n', [FctName]), e_stop_lst(LBNoStop), e_call_fct_lst(LFctName), format(stream_c, ' fd_exit_point~n', []), format(stream_c, ' fd_return~n', []), format(stream_c, '~nfd_end_internal~n', []). e_stop_lst([]). e_stop_lst([BNoStop|LBNoStop]) :- format(stream_c, ' fd_stop_constraint(~d)~n', [BNoStop]), e_stop_lst(LBNoStop). e_test_case_lst([], [], []). e_test_case_lst([ca(co(Term, LWNext, LWInst), _, _)|LCase], [FctName|LFctName], LWInst) :- LWNext = [fd_test_switch_condition(Term, FctName)|LWInst1], e_test_case_lst(LCase, LFctName, LWInst1). e_bloc_lst([], []). e_bloc_lst([Bloc|LBloc], [FctName|LFctName]) :- g_read(bloc, BlNo), format(stream_c, '~n~n\t/* Bloc #~d */~n', [BlNo]), e_bloc_one(Bloc, FctName), BlNo1 is BlNo + 1, g_assign(bloc, BlNo1), e_bloc_lst(LBloc, LFctName). e_bloc_one(bl(BNo, LDep, LUse, LWInst, TellFdv, Always), FctName1) :- e_bloc(LUse, LWInst, FctName), e_fct_install_triggers(BNo, LDep, TellFdv, Always, FctName, FctName1). e_bloc(LUse, LWInst1, FctName) :- g_read(bloc, BlNo), BlNo1 is BlNo + 1, g_assign(bloc, BlNo1), internal_fct_name(bloc, BlNo, FctName), e_bloc_load_use(LUse, LCVarUsed, LWInst1, LWInst), close_list(LCVarUsed), simplif_code(LWInst, LWSimpl), alloc_and_emit_fct_code(FctName, LCVarUsed, LWSimpl, t). e_fct_install_triggers(BNo, LDep, TellFdv, Always, FctName, FctName1) :- e_has_dependencies(LDep), !, ( Always = always -> Optim = 0 ; Optim = 1 ), atom_concat(FctName, '_inst', FctName1), format(stream_c, '~nfd_begin_internal(~a)~n~n', [FctName1]), format(stream_c, ' fd_local_cf_pointer~n', []), format(stream_c, ' fd_create_c_frame(~a,~d,~d)~n', [FctName, TellFdv, Optim]), ( BNo = -1 -> true ; format(stream_c, ' fd_cf_in_a_frame(~d)~n', [BNo]) ), e_install_trig(LDep), e_call_internal(FctName, t), format(stream_c, ' fd_exit_point~n', []), format(stream_c, ' fd_return~n', []), format(stream_c, '~nfd_end_internal~n', []). e_fct_install_triggers(_, _, _, _, FctName, FctName). e_install_trig([]). e_install_trig([m(_, fdv, I, i(Min, Max, Dom, Val))|LDep]) :- e_compute_dep_chain(Min, Max, Dom, Val, Chain), !, format(stream_c, ' fd_add_dependency(~d,~a)~n', [I, Chain]), e_install_trig(LDep). e_install_trig([m(_, l_fdv, I, i(Min, Max, Dom, Val))|LDep]) :- e_compute_dep_chain(Min, Max, Dom, Val, Chain), !, format(stream_c, ' fd_add_list_dependency(~d,~a)~n', [I, Chain]), e_install_trig(LDep). e_install_trig([_|LDep]) :- e_install_trig(LDep). e_has_dependencies([m(_, T, _, i(Min, Max, Dom, Val))|_]) :- ( T = fdv ; T = l_fdv ), e_compute_dep_chain(Min, Max, Dom, Val, _), !. e_has_dependencies([_|LDep]) :- e_has_dependencies(LDep). e_bloc_load_use([], _, LWNext, LWNext) :- !. e_bloc_load_use([m(V, T, I, Mark)|LUse], LCVarUsed, LWNext, LWInst) :- e_bloc_load_one(T, V, I, Mark, LCVarUsed, LWInst1, LWInst), e_bloc_load_use(LUse, LCVarUsed, LWNext, LWInst1). e_bloc_load_one(fdv, V, I, Mark, LCVarUsed, LWNext, LWInst) :- Mark = i(Min, Max, Dom, Val), e_compute_dep_chain(Min, Max, Dom, Val, Chain), !, e_bloc_load_fdv(Chain, Min, Max, Dom, Val, V, I, LCVarUsed, LWNext, LWInst). e_bloc_load_one(range, _, I, range(R), _, LWNext, LWInst) :- !, ( nonvar(I) -> LWInst = [fd_load_range(R, I)|LWNext] ; LWInst = LWNext ). e_bloc_load_one(T, V, I, _, LCVarUsed, LWNext, [WInst|LWNext]) :- nonvar(I), !, atom_concat(fd_load_, T, F), use_c_var(T, V, LCVarUsed, A), WInst =.. [F, A, I]. e_bloc_load_one(T, V, _, _, LCVarUsed, LWNext, LWNext) :- use_c_var(T, V, LCVarUsed, _). use_c_var(T, V, LCVarUsed, A) :- atom_concat(T, V, A), memberchk(cv(T, A), LCVarUsed). e_bloc_load_fdv(val, Min, Max, Dom, _, V, I, LCVarUsed, LWNext, LWInst) :- use_c_var(val, V, LCVarUsed, AVal), LWInst = [fd_load_val(AVal, I)|LWInst1], ( nonvar(Dom) -> Dom = t(R), LWInst1 = [fd_range_interval(R, AVal, AVal)|LWInst2] ; LWInst1 = LWInst2 ), ( nonvar(Min) -> use_c_var(min, V, LCVarUsed, AMin), LWInst2 = [fd_value_copy(AMin, AVal)|LWInst3] ; LWInst2 = LWInst3 ), ( nonvar(Max) -> use_c_var(max, V, LCVarUsed, AMax), LWInst3 = [fd_value_copy(AMax, AVal)|LWNext] ; LWInst3 = LWNext ). e_bloc_load_fdv(dom, Min, Max, t(R), _, V, I, LCVarUsed, LWNext, LWInst) :- LWInst = [fd_load_dom(R, I)|LWInst1], ( nonvar(Min) -> use_c_var(min, V, LCVarUsed, AMin), LWInst1 = [fd_min_of_range(AMin, R)|LWInst2] ; LWInst1 = LWInst2 ), ( nonvar(Max) -> use_c_var(max, V, LCVarUsed, AMax), LWInst2 = [fd_max_of_range(AMax, R)|LWNext] ; LWInst2 = LWNext ). e_bloc_load_fdv(min_max, _, _, _, _, V, I, LCVarUsed, LWNext, LWInst) :- use_c_var(min, V, LCVarUsed, AMin), use_c_var(max, V, LCVarUsed, AMax), LWInst = [fd_load_min_max(AMin, AMax, I)|LWNext]. e_bloc_load_fdv(min, _, _, _, _, V, I, LCVarUsed, LWNext, LWInst) :- use_c_var(min, V, LCVarUsed, AMin), LWInst = [fd_load_min(AMin, I)|LWNext]. e_bloc_load_fdv(max, _, _, _, _, V, I, LCVarUsed, LWNext, LWInst) :- use_c_var(max, V, LCVarUsed, AMax), LWInst = [fd_load_max(AMax, I)|LWNext]. e_compute_dep_chain(_, _, _, Val, val) :- nonvar(Val), !. % val used e_compute_dep_chain(_, _, Dom, _, dom) :- nonvar(Dom), !. % dom used e_compute_dep_chain(Min, Max, _, _, min) :- nonvar(Min), var(Max), !. % only min used e_compute_dep_chain(Min, Max, _, _, max) :- var(Min), nonvar(Max), !. % only max used e_compute_dep_chain(Min, Max, _, _, min_max) :- nonvar(Min), nonvar(Max). % min and max used simplif_code([], []). simplif_code([fd_range_compl(R1), fd_range_compl(R2)|LWInst], LWSimpl) :- R1 == R2, !, simplif_code(LWInst, LWSimpl). simplif_code([fd_range_interval(R1, T1, T2), fd_tell_range(I, R2)|LWInst], LWSimpl) :- R1 == R2, !, simplif_code([fd_tell_interval(I, T1, T2)|LWInst], LWSimpl). simplif_code([fd_tell_interval(I, T1, T2)|LWInst], LWSimpl) :- T1 == T2, !, simplif_code([fd_tell_value(I, T1)|LWInst], LWSimpl). simplif_code([fd_range_full(R1), fd_range_reset_value(R2, T), fd_tell_range(I, R3)|LWInst], LWSimpl) :- R1 == R2, R1 == R3, !, simplif_code([fd_tell_not_value(I, T)|LWInst], LWSimpl). simplif_code([fd_range_empty(R1)|LWInst], LWSimpl1) :- simpl_get_lst(LWInst, R1, LWReset, LWInst1), simplif_code(LWInst1, LWInst2), ( LWInst2 = [fd_range_compl(R2)|LWInst3], % compl of list R1 == R2, append([fd_range_full(R1)|LWReset], LWInst3, LWSimpl) ; LWReset = [WReset], % only one element arg(2, WReset, Term), LWSimpl = [fd_range_interval(R1, Term, Term)|LWInst2] ), !, simplif_code(LWSimpl, LWSimpl1). simplif_code([fd_range_interval(R1, T1, T2), fd_range_union(R2, R3)|LWInst], LWSimpl1) :- T1 == T2, % R union {value} = set value in R R1 == R3, LWSimpl = [fd_range_set_value(R2, T1)|LWInst], simplif_code(LWSimpl, LWSimpl1). simplif_code([WInst|LWInst], [WInst|LWInst1]) :- simplif_code(LWInst, LWInst1). simpl_get_lst([fd_range_set_value(R2, Term)|LWInst], R1, [WReset|LWReset], LWInst1) :- R1 == R2, !, functor(WReset, fd_range_reset_value, 2), arg(1, WReset, R2), arg(2, WReset, Term), simpl_get_lst(LWInst, R1, LWReset, LWInst1). simpl_get_lst(LWInst, _, [], LWInst). internal_fct_name(Kind, No, FctName) :- g_read(name, Name), number_atom(No, ANo), atom_concat(Name, '_', X1), atom_concat(X1, Kind, X2), atom_concat(X2, '_', X3), atom_concat(X3, ANo, FctName). alloc_and_emit_fct_code(FctName, LCVarUsed, LWInst, LocalFdvAdr) :- format(stream_c, '~nfd_begin_internal(~a)~n~n', [FctName]), allocate_registers(LWInst, MaxUsedReg), ( LocalFdvAdr = t -> format(stream_c, ' fd_local_fdv_adr~n', []) ; true ), emit_c_vars_lst(LCVarUsed), emit_used_regs_lst(MaxUsedReg), nl(stream_c), ( MaxUsedReg >= 0 -> format(stream_c, ' fd_allocate~n', []), Alloc = t ; Alloc = f ), emit_inst_lst(LWInst, Alloc), format(stream_c, '~nfd_end_internal~n', []). emit_c_vars_lst([]). emit_c_vars_lst([cv(T, A)|LCVarUsed]) :- ( ( T = int ; T = val ; T = min ; T = max ) -> I1 = value ; I1 = T ), format(stream_c, ' fd_local_~a_var(~a)~n', [I1, A]), emit_c_vars_lst(LCVarUsed). emit_used_regs_lst(MaxUsedReg) :- for(I, 0, MaxUsedReg), format(stream_c, ' fd_local_range_var(~d)~n', [I]), fail. emit_used_regs_lst(_). emit_inst_lst([], Alloc) :- format(stream_c, ' fd_exit_point~n', []), ( Alloc = t -> format(stream_c, ' fd_deallocate~n', []) ; true ), format(stream_c, ' fd_return~n', []). emit_inst_lst([WInst|LWInst], Alloc) :- dummy_instruction(WInst), !, emit_inst_lst(LWInst, Alloc). emit_inst_lst([WInst|LWInst], t) :- functor(WInst, F, _), ( sub_atom(F, 0, _, _, fd_tell_) ; sub_atom(F, 0, _, _, fd_check_fct) ), !, format(stream_c, ' fd_deallocate~n', []), format(stream_c, ' ~w~n', [WInst]), emit_inst_lst(LWInst, already). emit_inst_lst([WInst|LWInst], Alloc) :- Alloc \== f, functor(WInst, F, _), sub_atom(F, 0, _, _, fd_forall_end), !, format(stream_c, ' fd_allocate~n', []), format(stream_c, ' ~w~n', [WInst]), emit_inst_lst(LWInst, f). emit_inst_lst([WInst|LWInst], Alloc) :- format(stream_c, ' ~w~n', [WInst]), emit_inst_lst(LWInst, Alloc). :- include('../Pl2Wam/reg_alloc.pl'). % alias stopping instructions alias_stop_instruction(_) :- fail. % instruction codification codification(WamInst, LCode) :- codif(WamInst, LCode), !. % FD instructions using Ranges codif(fd_tell_range(_, RR), [r(RR)]). codif(fd_load_range(RR, _), [w(RR)]). codif(fd_load_dom(RR, _), [w(RR)]). codif(fd_min_of_range(_, RR), [r(RR)]). codif(fd_max_of_range(_, RR), [r(RR)]). codif(fd_range_interval(RR, _, _), [w(RR)]). codif(fd_range_union(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_inter(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_compl(RR), [r(RR), w(RR)]). codif(fd_range_empty(RR), [w(RR)]). codif(fd_range_set_value(RR, _), [r(RR), w(RR)]). codif(fd_range_full(RR), [w(RR)]). codif(fd_range_reset_value(RR, _), [r(RR), w(RR)]). codif(fd_range_add_range(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_sub_range(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_mul_range(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_div_range(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_mod_range(RR, RR1), [r(RR), r(RR1), w(RR)]). codif(fd_range_add_value(RR, _), [r(RR), w(RR)]). codif(fd_range_sub_value(RR, _), [r(RR), w(RR)]). codif(fd_range_mul_value(RR, _), [r(RR), w(RR)]). codif(fd_range_div_value(RR, _), [r(RR), w(RR)]). codif(fd_range_mod_value(RR, _), [r(RR), w(RR)]). codif(fd_range_copy(RR, RR1), [c(RR1, RR)]). codif(fd_range_fct(_, RR, FdArg), [w(RR)|LCode]) :- FdArg =.. [_|FdLstArg], create_r_code_lst(FdLstArg, [], LCode). codif(X, LCode) :- create_r_code_lst(X, [], LCode). create_r_code_lst(range_arg(RR), LNext, [r(RR)|LNext]) :- !. create_r_code_lst(T, LNext, LNext) :- atomic(T), !. create_r_code_lst(T, LNext, LCode) :- compound(T), !, functor(T, _, A), create_r_code_lst1(0, A, T, LNext, LCode). create_r_code_lst1(I, A, T, LNext, LCode) :- ( I = A -> LCode = LNext ; I1 is I + 1, arg(I1, T, T1), create_r_code_lst(T1, LCode1, LCode), create_r_code_lst1(I1, A, T, LNext, LCode1) ). % dummy instructions dummy_instruction(fd_range_copy(R, R)). �����������gprolog-1.4.5/src/Fd2C/fd2c.pl����������������������������������������������������������������������0000644�0001750�0001750�00000015537�13021324543�014012� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint definition file to C code compiler * * File : fd2c.pl * * Descr.: main file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ fd2c(Args) :- catch(fd2c1(Args), Err, exception(Err)). init :- % to test under top-level catch(close(stream_fd), _, true), catch(close(stream_c), _, true). fd2c1(Args) :- cmd_line_args(Args, FdFile0, CFile0), fd_file(FdFile0, FdFile), c_file(CFile0, FdFile, CFile), open(FdFile, read, _, [alias(stream_fd)]), open(CFile, write, _, [alias(stream_c)]), emit_code_init(FdFile), file_to_token_lst(LToken), close(stream_fd), parse_and_emit(LToken), close(stream_c). parse_and_emit(LToken) :- ( LToken = [] -> true ; parse_user_cstr(Cstr, LToken, LToken1), emit_user_cstr(Cstr), parse_and_emit(LToken1) ). fd_file(FdFile, FdFile1) :- decompose_file_name(FdFile, _, _, Suffix), ( Suffix \== '' -> FdFile1 = FdFile ; atom_concat(FdFile, '.fd', FdFile1) ). c_file('', FdFile, CFile) :- !, decompose_file_name(FdFile, _, Prefix, _), atom_concat(Prefix, '.c', CFile). c_file(CFile, _, CFile). % Command-line options reading cmd_line_args(Args, FdFile, CFile) :- g_assign(fdfile, ''), g_assign(cfile, ''), cmd_line_args(Args), g_read(fdfile, FdFile), ( FdFile = '' -> write('no input file'), nl, abort ; true ), g_read(cfile, CFile). cmd_line_args([]). cmd_line_args([Arg|LArg]) :- cmd_line_arg1(Arg, LArg, LArg1), !, cmd_line_args(LArg1). cmd_line_arg1('-o', LArg, LArg1) :- cmd_line_arg1('--output', LArg, LArg1). cmd_line_arg1('--output', LArg, LArg1) :- ( LArg = [CFile|LArg1], sub_atom(CFile, 0, 1, _, Prefix), Prefix \== (-) ; format('FILE missing after --output option~n', []), abort ), g_read(cfile, CFile0), ( CFile0 = '' -> true ; format('output file already specified (~a)~n', [CFile0]), abort ), g_assign(cfile, CFile). cmd_line_arg1('--version', LArg, LArg) :- display_copying, stop. cmd_line_arg1('-h', LArg, LArg1) :- cmd_line_arg1('--help', LArg, LArg1). cmd_line_arg1('--help', LArg, LArg) :- ( h(L), write(L), nl, fail ; nl, write('Report bugs to bug-prolog@gnu.org.'), nl, stop ). cmd_line_arg1(Arg, _, _) :- sub_atom(Arg, 0, 1, _, -), format('unknown option ~a - try fd2c --help~n', [Arg]), abort. cmd_line_arg1(FdFile, LArg, LArg) :- g_read(fdfile, FdFile0), ( FdFile0 = '' -> true ; format('input file already specified (~a)~n', [FdFile0]), abort ), g_assign(fdfile, FdFile). % Copying display_copying :- current_prolog_flag(prolog_name, Name), current_prolog_flag(prolog_version, Version), current_prolog_flag(prolog_copyright, Copyright), format('FD Constraints to C Compiler (~a) ~a~n', [Name, Version]), format('By Daniel Diaz~n', []), write(Copyright), nl, format('~a comes with ABSOLUTELY NO WARRANTY.~n', [Name]), format('You may redistribute copies of ~a~n', [Name]), format('under the terms of the GNU Lesser General Public License.~n', []), format('For more information about these matters, see the files named COPYING.~n', []). % Help h('Usage: fd2c [OPTION...] FILE'). h(''). h('Options:'). h(' -o FILE, --output FILE set output file name'). h(' --help print this help and exit'). h(' --version print version number and exit'). h(''). h('''user'' can be given as FILE for the standard input/output'). % Exception recovery exception(error(syntax_error(_), _)) :- !, syntax_error_info(_, Line, Char, Msg), error('~d syntax error: ~a (char:~d)', [Line, Msg, Char]). exception(error(existence_error(source_sink, File), _)) :- !, error('cannot open file ~w - does not exist', [File]). exception(error(permission_error(open, source_sink, File), _)) :- !, error('cannot open file ~w - permission error', [File]). exception(Err) :- error('exception raised: ~w', [Err]). error(Msg, Args) :- g_read(fdfile, FdFile), format(user_output, 'error: ~a:', [FdFile]), format(user_output, Msg, Args), nl(user_output), abort. warn(Msg, Args) :- g_read(fdfile, FdFile), format(user_output, 'warning: ~a:', [FdFile]), format(user_output, Msg, Args), nl(user_output). % Starting directive go :- argument_list(L), fd2c(L). :- initialization(go). �����������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/Makefile.in������������������������������������������������������������������0000644�0001750�0001750�00000000657�13021324543�014701� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GPLC = @GPLC@ GPLCFLAGS = --fast-math OBJS = fd2c@OBJ_SUFFIX@ read_file@OBJ_SUFFIX@ parse@OBJ_SUFFIX@ \ compile@OBJ_SUFFIX@ .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .pl $(SUFFIXES) .pl@OBJ_SUFFIX@: $(GPLC) -c $(GPLCFLAGS) $*.pl fd2c@EXE_SUFFIX@: $(OBJS) $(GPLC) -o fd2c@EXE_SUFFIX@ --no-fd-lib --min-bips $(OBJS) clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp fd2c@EXE_SUFFIX@ distclean: clean ���������������������������������������������������������������������������������gprolog-1.4.5/src/Fd2C/parse.pl���������������������������������������������������������������������0000644�0001750�0001750�00000050447�13021324543�014305� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint definition file to C code compiler * * File : parse.pl * * Descr.: parsing and some code emission * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ parse_user_cstr(uc(Name, AFSize, LHVar, Body)) --> head(Name, NbHVar, LHVar), terminal_check('{'), { g_assign(afsize, NbHVar), retractall(hvar(_)), asserta(hvar(LHVar)), retractall(bname(_, _)) }, body(Body), terminal_check('}'), !, { g_read(afsize, AFSize), close_list(LHVar) }. head(Name, NbHVar, LHVar) --> ident_check(Name), terminal_check('('), decl_lst(0, NbHVar, LHVar), terminal_check(')'), !. decl_lst(I, NbHVar, [HVar|LHVar]) --> decl_one(I, HVar), { I1 is I + 1 }, decl_rest_lst(I1, NbHVar, LHVar). decl_rest_lst(I, NbHVar, LHVar) --> terminal(','), !, decl_lst(I, NbHVar, LHVar). decl_rest_lst(I, I, _) --> []. decl_one(I, v(V, T, I)) --> type(T), a_var(V), !. decl_one(_, _) --> syn_error('variable declaration'). type(int) --> terminal(int). type(range) --> terminal(range). type(fdv) --> terminal(fdv). type(any) --> terminal(any). type(l_int) --> terminal(l_int). type(l_range) --> terminal(l_range). type(l_fdv) --> terminal(l_fdv). type(l_any) --> terminal(l_any). body(by(LBloc, WaitSwt)) --> bloc_lst(LBloc), wait_swt(WaitSwt), !. body(_) --> syn_error(body). wait_swt(ws(LUse, LCase)) --> terminal(wait_switch), !, { clause(hvar(LVar), _) }, case_lst(LVar, LUse, LCase), { close_list(LUse) }. wait_swt(no_wait_switch) --> []. case_lst(LVar, LUse, [Case|LCase]) --> case_one(LVar, LUse, Case), case_rest_lst(LVar, LUse, LCase). case_rest_lst(LVar, LUse, LCase) --> case_lst(LVar, LUse, LCase), !. case_rest_lst(_, _, []) --> []. case_one(LVar, LUse, ca(co(Term, LWNext, LWInst), LBNoStop, LBloc)) --> terminal(case), term(LVar, LUse, Term, LWNext, LWInst), stop_lst(LBNoStop), bloc_lst(LBloc). stop_lst([BNoStop|LBNoStop]) --> stop_one(BNoStop), stop_lst(LBNoStop). stop_lst([]) --> []. stop_one(BNoStop) --> terminal(stop), !, ident_check(BName), ( { clause(bname(BName, BNoStop), _) } -> { true } ; sem_error('undeclared bloc name "~a"', [BName]) ). bloc_lst([Bloc|LBloc]) --> bloc_one(Bloc), bloc_lst(LBloc). bloc_lst([]) --> []. bloc_one(bl(BNo, LDep, LUse, LWInst, TellFdv, Always)) --> { clause(hvar(LVar), _) }, foreach(LVar, LUse, LWInst1, LWInst, HasForEach), terminal(start), bloc_name(BNo), elem_lst(LVar, LUse, LWInst2, LWInst1), forall(LVar, LUse, LWInst3, LWInst2, HasForAll), last_elem(LVar, LUse, TellFdv, LWInst4, LWInst3), { HasForAll = t -> LWInst4 = [fd_forall_end|LWInst5] ; LWInst4 = LWInst5 }, { HasForEach = t -> LWInst5 = [fd_foreach_end] ; LWInst5 = [] }, trig(LVar, LUse, LDep), always(Always), { close_list(LDep), close_list(LUse) }. bloc_name(BNo) --> terminal('('), !, ident_check(BName), ( { clause(bname(BName, _), _) } -> sem_error('bloc name already used "~a"', [BName]) ; { g_read(afsize, BNo), AFSize is BNo + 1, g_assign(afsize, AFSize), assertz(bname(BName, BNo)) } ), terminal_check(')'). bloc_name(-1) --> []. trig(LVar, LUse, LDep) --> terminal(trigger), terminal(also), !, terminal_check(on), trig_lst(LVar, LDep), { add_use_to_dep(LUse, LDep) }. trig(LVar, _, LDep) --> terminal(trigger), !, terminal_check(on), trig_lst(LVar, LDep). trig(_, LUse, LDep) --> { add_use_to_dep(LUse, LDep) }. trig_lst(LVar, LDep) --> trig_one(LVar, LDep), trig_rest_lst(LVar, LDep). trig_rest_lst(LVar, LDep) --> terminal(','), trig_lst(LVar, LDep), !. trig_rest_lst(_, _) --> []. trig_one(LVar, LDep) --> terminal(What), { What = min ; What = max ; What = dom ; What = val }, !, terminal_check('('), a_var(V), terminal_check(')'), { get_typeof(LVar, V, T, I), ( T \== fdv, T \== l_fdv -> var_check_type(LVar, V, fdv, _, _, _) % type error ; true), (What = dom -> What1 = dom(_) ; What1 = What), add_marked_var(LDep, V, T, I, What1) }. always(always) --> terminal(always), !. always(optimized) --> []. elem_lst(LVar, LUse, LWNext, LWInst) --> elem_one(LVar, LUse, LWInst1, LWInst), elem_lst(LVar, LUse, LWNext, LWInst1). elem_lst(_, _, LWNext, LWNext) --> []. elem_one(LVar, LUse, LWNext, LWInst) --> type(T), a_var(V), !, check_type_int_or_range(T), { add_local_var(LVar, v(V, T, I)) }, local_var_assign(LVar, LUse, V, T, I, LWNext, LWInst). elem_one(LVar, LUse, LWNext, LWInst) --> a_var(V), terminal(=), !, { get_typeof(LVar, V, T, I) }, check_type_int_or_range(T), assign_right_value(LVar, LUse, V, T, I, LWNext, LWInst). elem_one(LVar, LUse, LWNext, LWInst) --> terminal(fail), !, terminal_check(if), term(LVar, LUse, Term, LWInst1, LWInst), { LWInst1 = [fd_test_fail_condition(Term)|LWNext] }. elem_one(LVar, LUse, LWNext, LWInst) --> terminal(exit), !, terminal_check(if), term(LVar, LUse, Term, LWInst1, LWInst), { LWInst1 = [fd_test_exit_condition(Term)|LWNext] }. check_type_int_or_range(int) --> !. check_type_int_or_range(range) --> !. check_type_int_or_range(_) --> syn_error('int or range type'). local_var_assign(LVar, LUse, V, T, I, LWNext, LWInst) --> terminal(=), !, assign_right_value(LVar, LUse, V, T, I, LWNext, LWInst). local_var_assign(_, _, _, _, _, LWNext, LWNext) --> []. assign_right_value(LVar, LUse, V, int, I, LWNext, LWInst) --> { atom_concat(int, V, X), add_marked_var(LUse, V, int, I, _) }, term(LVar, LUse, Term, LWInst, LWInst1), !, { LWInst1 = [fd_init_local_value_var(X, Term)|LWNext] }. assign_right_value(LVar, LUse, V, range, I, LWNext, LWInst) --> { add_marked_var(LUse, V, range, I, range(Range)) }, range(LVar, LUse, Range, LWNext, LWInst), !. assign_right_value(_, _, _, _, _, _, _) --> syn_error('right value'). foreach(LVar, LUse, LWNext, LWInst, t) --> terminal(foreach), !, var_check_new(LVar, V), terminal_check(in), var_check_type(LVar, VL, l_fdv, IL), terminal_check(do), { add_marked_var(LUse, VL, l_fdv, IL, _), g_read(afsize, I), % local var but must in the AF (for tell for instance) AFSize is I + 1, g_assign(afsize, AFSize), add_local_var(LVar, v(V, fdv, I)), atom_concat(l_fdv, VL, VL1), LWInst = [fd_foreach(I, VL1)|LWNext] }. foreach(_, _, LWNext, LWNext, f) --> []. forall(LVar, LUse, LWNext, LWInst, t) --> terminal(forall), !, var_check_new(LVar, V), terminal_check(in), var_check_type(LVar, VL, l_fdv, IL), terminal_check(do), { add_marked_var(LUse, VL, l_fdv, IL, _), g_read(afsize, I), % local var but must in the AF (for tell for instance) AFSize is I + 1, g_assign(afsize, AFSize), add_local_var(LVar, v(V, fdv, I)), atom_concat(l_fdv, VL, VL1), LWInst = [fd_forall(I, VL1)|LWNext] }. forall(_, _, LWNext, LWNext, f) --> []. last_elem(LVar, LUse, -1, LWNext, LWInst) --> c_fct(LVar, LUse, Head, LArg, LWInst1, LWInst), { Term =.. [Head|LArg], LWInst1 = [fd_check_fct(Term)|LWNext] }. last_elem(LVar, LUse, TellFdv, LWNext, LWInst) --> x_in_r(LVar, LUse, TellFdv, LWNext, LWInst), !. x_in_r(LVar, LUse, I, LWNext, LWInst) --> var_check_type(LVar, _, fdv, I), terminal_check(in), range(LVar, LUse, Range, LWInst1, LWInst), { LWInst1 = [fd_tell_range(I, Range)|LWNext] }. range(LVar, LUse, Range, LWNext, LWInst) --> r_add(LVar, LUse, Range, LWInst1, LWInst), r_rest_add(LVar, LUse, Range, LWNext, LWInst1). r_rest_add(LVar, LUse, Range, LWNext, LWInst) --> terminal(:), !, r_add(LVar, LUse, Range1, LWInst1, LWInst), { LWInst1 = [fd_range_union(Range, Range1)|LWInst2] }, r_rest_add(LVar, LUse, Range, LWNext, LWInst2). r_rest_add(_, _, _, LWNext, LWNext) --> []. r_add(LVar, LUse, Range, LWNext, LWInst) --> r_mul(LVar, LUse, Range, LWInst1, LWInst), r_rest_mul(LVar, LUse, Range, LWNext, LWInst1). r_rest_mul(LVar, LUse, Range, LWNext, LWInst) --> terminal(&), !, r_mul(LVar, LUse, Range1, LWInst1, LWInst), { LWInst1 = [fd_range_inter(Range, Range1)|LWInst2] }, r_rest_mul(LVar, LUse, Range, LWNext, LWInst2). r_rest_mul(_, _, _, LWNext, LWNext) --> []. r_mul(LVar, LUse, Range, LWNext, LWInst) --> r_add2(LVar, LUse, Range, LWInst1, LWInst), r_rest_add2(LVar, LUse, Range, LWNext, LWInst1). r_rest_add2(LVar, LUse, Range, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [++, --]) }, !, r_add2(LVar, LUse, Range1, LWInst1, LWInst), { make_inst(Range, Op, Range1, WInst), LWInst1 = [WInst|LWInst2] }, r_rest_add2(LVar, LUse, Range, LWNext, LWInst2). r_rest_add2(_, _, _, LWNext, LWNext) --> []. r_add2(LVar, LUse, Range, LWNext, LWInst) --> r_mul2(LVar, LUse, Range, LWInst1, LWInst), r_rest_mul2(LVar, LUse, Range, LWNext, LWInst1). r_rest_mul2(LVar, LUse, Range, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [**, //, '%%']) }, !, r_mul2(LVar, LUse, Range1, LWInst1, LWInst), { make_inst(Range, Op, Range1, WInst), LWInst1 = [WInst|LWInst2] }, r_rest_mul2(LVar, LUse, Range, LWNext, LWInst2). r_rest_mul2(_, _, _, LWNext, LWNext) --> []. r_mul2(LVar, LUse, Range, LWNext, LWInst) --> r_prim(LVar, LUse, Range, LWInst1, LWInst), r_rest_prim(LVar, LUse, Range, LWNext, LWInst1). r_rest_prim(LVar, LUse, Range, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [+, -, *, /, '%']) }, !, term(LVar, LUse, Term, LWInst1, LWInst), { make_inst(Range, Op, Term, WInst), LWInst1 = [WInst|LWInst2] }, r_rest_prim(LVar, LUse, Range, LWNext, LWInst2). r_rest_prim(_, _, _, LWNext, LWNext) --> []. r_prim(LVar, LUse, Range, LWNext, LWInst) --> terminal(~), !, r_prim(LVar, LUse, Range, LWInst1, LWInst), { LWInst1 = [fd_range_compl(Range)|LWNext] }. r_prim(LVar, LUse, Range, LWNext, LWInst) --> term(LVar, LUse, Term1, LWInst1, LWInst), terminal(..), !, term(LVar, LUse, Term2, LWInst2, LWInst1), { LWInst2 = [fd_range_interval(Range, Term1, Term2)|LWNext] }. r_prim(LVar, LUse, Range, LWNext, LWInst) --> terminal('{'), !, term_lst(LVar, LUse, LTerm, LWInst1, LWInst), terminal_check('}'), { compile_term_lst(LTerm, Range, LWNext, LWInst1) }. r_prim(LVar, LUse, Range, LWNext, LWInst) --> terminal(dom), terminal_check('('), var_check_type(LVar, V, fdv, I), terminal_check(')'), !, { add_marked_var(LUse, V, fdv, I, dom(Range1)) }, { LWInst = [fd_range_copy(Range, Range1)|LWNext] }. r_prim(LVar, LUse, Range, LWNext, LWInst) --> a_var(V), { get_typeof(LVar, V, range, I), !, add_marked_var(LUse, V, range, I, range(Range1)) }, { LWInst = [fd_range_copy(Range, Range1)|LWNext] }. r_prim(LVar, LUse, Range, LWNext, LWInst) --> c_fct(LVar, LUse, Head, LArg, LWInst1, LWInst), !, { length(LArg, N), number_atom(N, NA), atom_concat(arg_, NA, NA1), Args =.. [NA1|LArg], LWInst1 = [fd_range_fct(Head, Range, Args)|LWNext] }. r_prim(LVar, LUse, Range, LWNext, LWInst) --> terminal('('), range(LVar, LUse, Range, LWNext, LWInst), terminal(')'). term_lst(LVar, LUse, [Term|LTerm], LWNext, LWInst) --> term(LVar, LUse, Term, LWInst1, LWInst), !, term_lst_rest(LVar, LUse, LTerm, LWNext, LWInst1). term_lst(_, _, [], LWNext, LWNext) --> []. term_lst_rest(LVar, LUse, [Term|LTerm], LWNext, LWInst) --> terminal(','), !, term(LVar, LUse, Term, LWInst1, LWInst), term_lst_rest(LVar, LUse, LTerm, LWNext, LWInst1). term_lst_rest(_, _, [], LWNext, LWNext) --> []. compile_term_lst(LTerm, Range, LWNext, LWInst) :- LWInst = [fd_range_empty(Range)|LWInst1], compile_term_lst1(LTerm, Range, LWNext, LWInst1). compile_term_lst1([], _, LWNext, LWNext). compile_term_lst1([Term|LTerm], R, LWNext, [fd_range_set_value(R, Term)|LWInst]) :- compile_term_lst1(LTerm, R, LWNext, LWInst). term(LVar, LUse, Term1, LWNext, LWInst) --> t_log(LVar, LUse, Term, LWInst1, LWInst), t_rest_log(LVar, LUse, Term, Term1, LWNext, LWInst1). t_rest_log(LVar, LUse, Term1, Term4, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [&&, '||']) }, !, t_log(LVar, LUse, Term2, LWInst1, LWInst), { make_term(Term1, Op, Term2, Term3) }, t_rest_log(LVar, LUse, Term3, Term4, LWNext, LWInst1). t_rest_log(_, _, Term, Term, LWNext, LWNext) --> []. t_log(LVar, LUse, Term1, LWNext, LWInst) --> t_cmp(LVar, LUse, Term, LWInst1, LWInst), t_rest_cmp(LVar, LUse, Term, Term1, LWNext, LWInst1). t_rest_cmp(LVar, LUse, Term1, Term3, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [=, ==, '!=', \=, <, <=, >, >=]) }, !, t_cmp(LVar, LUse, Term2, LWNext, LWInst), { make_term(Term1, Op, Term2, Term3) }. t_rest_cmp(_, _, Term, Term, LWNext, LWNext) --> []. t_cmp(LVar, LUse, Term1, LWNext, LWInst) --> t_add(LVar, LUse, Term, LWInst1, LWInst), t_rest_add(LVar, LUse, Term, Term1, LWNext, LWInst1). t_rest_add(LVar, LUse, Term1, Term4, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [+, -]) }, !, t_add(LVar, LUse, Term2, LWInst1, LWInst), { make_term(Term1, Op, Term2, Term3) }, t_rest_add(LVar, LUse, Term3, Term4, LWNext, LWInst1). t_rest_add(_, _, Term, Term, LWNext, LWNext) --> []. t_add(LVar, LUse, Term1, LWNext, LWInst) --> t_mul(LVar, LUse, Term, LWInst1, LWInst), t_rest_mul(LVar, LUse, Term, Term1, LWNext, LWInst1). t_rest_mul(LVar, LUse, Term1, Term4, LWNext, LWInst) --> terminal(Op), { memberchk(Op, [*, /<, />, mod]) }, !, t_mul(LVar, LUse, Term2, LWInst1, LWInst), { make_term(Term1, Op, Term2, Term3) }, t_rest_mul(LVar, LUse, Term3, Term4, LWNext, LWInst1). t_rest_mul(_, _, Term, Term, LWNext, LWNext) --> []. t_mul(LVar, LUse, - Term, LWNext, LWInst) --> terminal(-), !, t_mul(LVar, LUse, Term, LWNext, LWInst). t_mul(_, _, Term, LWNext, LWNext) --> int(Term), !. t_mul(_, _, max_integer, LWNext, LWNext) --> terminal(max_integer), !. t_mul(LVar, LUse, Term, LWNext, LWNext) --> terminal(What), { What = min ; What = max ; What = val }, terminal_check('('), var_check_type(LVar, V, fdv, I), terminal_check(')'), !, { atom_concat(What, V, Term), add_marked_var(LUse, V, fdv, I, What) }. t_mul(LVar, LUse, Term, LWNext, LWNext) --> a_var(V), { get_typeof(LVar, V, int, I), !, atom_concat(int, V, Term), add_marked_var(LUse, V, int, I, _) }. t_mul(LVar, LUse, Term, LWNext, LWInst) --> c_fct(LVar, LUse, Head, LArg, LWNext, LWInst), !, { Term =.. [Head|LArg] }. t_mul(LVar, LUse, Term, LWNext, LWInst) --> terminal('('), term(LVar, LUse, Term, LWNext, LWInst), terminal(')'). c_fct(_, _, Head, [], LWNext, LWNext) --> ident(Head), terminal('('), terminal(')'), !. c_fct(LVar, LUse, Head, LArg, LWNext, LWInst) --> ident(Head), terminal('('), parm_lst(LVar, LUse, LArg, LWNext, LWInst), terminal_check(')'), !. parm_lst(LVar, LUse, [Arg|LArg], LWNext, LWInst) --> parm_one(LVar, LUse, Arg, LWInst1, LWInst), !, parm_rest_lst(LVar, LUse, LArg, LWNext, LWInst1). parm_lst(_, _, _, _, _) --> syn_error('C fct parameter'). parm_rest_lst(LVar, LUse, LArg, LWNext, LWInst) --> terminal(','), !, parm_lst(LVar, LUse, LArg, LWNext, LWInst). parm_rest_lst(_, _, [], LWNext, LWNext) --> []. parm_one(LVar, LUse, Arg, LWNext, LWInst) --> term(LVar, LUse, Arg, LWNext, LWInst), ( terminal(..) -> { fail } ; { true } ). parm_one(LVar, LUse, range_arg(Range), LWNext, LWInst) --> range(LVar, LUse, Range, LWNext, LWInst). parm_one(LVar, LUse, Arg, LWNext, LWNext) --> a_var(V), % local var { get_typeof(LVar, V, T, I), atom_concat(T, V, Arg), add_marked_var(LUse, V, T, I, _) }. parm_one(LVar, LUse, &(Arg), LWNext, LWInst) --> terminal(&), % adr of parm_one(LVar, LUse, Arg, LWNext, LWInst). var_check_type(LVar, V, T, I) --> a_var(V), ( { get_typeof(LVar, V, T1, I) } -> ( { T = T1 } -> { true } ; sem_error('variable ~a declared as ~a used as ~a', [V, T1, T]) ) ; sem_error('undeclared variable ~a', [V]) ). var_check_new(LVar, V) --> a_var(V), ( { get_typeof(LVar, V, T, _) } -> sem_error('variable ~a already declared as ~a', [V, T]) ; { true } ). a_var(V) --> ident(V). ident(X) --> terminal(ident(X)). ident_check(X) --> ident(X), !. ident_check(_) --> syn_error(identifier). int(X) --> terminal(X), { integer(X) }. terminal(X) --> [t(X, _, _)]. terminal_check(X) --> terminal(X), !. terminal_check(X) --> syn_error(X). syn_error(Expected) --> [t(T, L, C)], { error('~d: syntax error : ~w expected at "~w" (char:~d)', [L, Expected, T, C]) }. sem_error(Msg, Args) --> [t(_, L, C)], { append([L, Msg|Args], [C], M), error('~d: ~? (char:~d)', M) }. % Utilities add_use_to_dep(LUse, _) :- var(LUse), !. add_use_to_dep([Use|LUse], LDep) :- arg(2, Use, T), ( T \== fdv, T \== l_fdv -> true ; member(Use, LDep) ), !, add_use_to_dep(LUse, LDep). make_term(T1, Op, T2, T3) :- convert(Op, Op1), !, functor(T3, Op1, 2), arg(1, T3, T1), arg(2, T3, T2). convert(/<, 'DivDn'). convert(/>, 'DivUp'). convert(mod, '%'). convert(=, ==). convert(\=, '!='). convert(X, X). make_inst(Arg1, Op, Arg2, WInst) :- inst_name(Op, F), !, functor(WInst, F, 2), arg(1, WInst, Arg1), arg(2, WInst, Arg2). inst_name(++, fd_range_add_range). inst_name(--, fd_range_sub_range). inst_name(**, fd_range_mul_range). inst_name(//, fd_range_div_range). inst_name('%%', fd_range_mod_range). inst_name(+, fd_range_add_value). inst_name(-, fd_range_sub_value). inst_name(*, fd_range_mul_value). inst_name(/, fd_range_div_value). inst_name('%', fd_range_mod_value). get_typeof(LVar, V, T, I) :- memb(v(V, T, I), LVar). memb(X, Y) :- nonvar(Y), Y = [H|T], ( H = X, ! ; memb(X, T) ). add_local_var(LVar, Decl) :- member(Decl, LVar), !. add_marked_var([m(V, T, I, Mark)|_], V, T, I, What) :- !, ( ( T = fdv ; T = l_fdv ), nonvar(What) -> ( What = min, Mark = i(t, _, _, _) ; What = max, Mark = i(_, t, _, _) ; What = dom(R), Mark = i(_, _, t(R), _) ; What = val, Mark = i(_, _, _, t) ), ! ; Mark = What ). add_marked_var([_|LUse], V, T, I, What) :- add_marked_var(LUse, V, T, I, What). close_list([]) :- !. close_list([_|L]) :- close_list(L). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/�������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013531� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/fd_inst.h����������������������������������������������������������������0000644�0001750�0001750�00000023471�13021324543�015333� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : fd_inst.h * * Descr.: FD instruction implementation - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /* FD Variable Frame */ #define FD_VARIABLE_FRAME_SIZE (OFFSET_RANGE + RANGE_SIZE + CHAINS_SIZE) #define FD_INT_VARIABLE_FRAME_SIZE (OFFSET_RANGE + RANGE_SIZE) #define OFFSET_RANGE 4 #define RANGE_SIZE (2 + (sizeof(Range) / sizeof(WamWord))) #define OFFSET_CHAINS (OFFSET_RANGE + RANGE_SIZE) #define CHAINS_SIZE 8 #define FD_Tag_Value(fdv_adr) (((WamWord *) fdv_adr)[0]) #define FD_INT_Date(fdv_adr) (((PlULong *) fdv_adr)[1]) #define Queue_Propag_Mask(fdv_adr) (((WamWord *) fdv_adr)[2]) #define Queue_Next_Fdv_Adr(fdv_adr)(((WamWord **) fdv_adr)[3]) #define Range_Stamp(fdv_adr) (((WamWord *) fdv_adr)[OFFSET_RANGE]) #define Nb_Elem(fdv_adr) (((WamWord *) fdv_adr)[OFFSET_RANGE + 1]) #define Range(fdv_adr) ((Range *) ((WamWord *) fdv_adr+OFFSET_RANGE + 2)) #define Chains_Stamp(fdv_adr) (((WamWord *) fdv_adr)[OFFSET_CHAINS]) #define Nb_Cstr(fdv_adr) (((WamWord *) fdv_adr)[OFFSET_CHAINS + 1]) #define Chains_Mask(fdv_adr) (((WamWord *) fdv_adr)[OFFSET_CHAINS + 2]) #define Chain_Min(fdv_adr) (((WamWord **) fdv_adr)[OFFSET_CHAINS + 3]) #define Chain_Max(fdv_adr) (((WamWord **) fdv_adr)[OFFSET_CHAINS + 4]) #define Chain_Min_Max(fdv_adr) (((WamWord **) fdv_adr)[OFFSET_CHAINS + 5]) #define Chain_Dom(fdv_adr) (((WamWord **) fdv_adr)[OFFSET_CHAINS + 6]) #define Chain_Val(fdv_adr) (((WamWord **) fdv_adr)[OFFSET_CHAINS + 7]) /* Shorthands for Queue management */ #define MASK_TO_KEEP_IN_QUEUE (1 << 8) /* only 5 chains */ #define Is_Var_In_Queue(fdv_adr) (Queue_Propag_Mask(fdv_adr) != 0) /* mask = 0 <=> not in the queue */ #define Del_Var_From_Queue(fdv_adr)(Queue_Propag_Mask(fdv_adr) = 0) /* Shorthands for Range(fdv_adr)'s fields */ #define Extra_Cstr(fdv_adr) (Range(fdv_adr)->extra_cstr) #define Min(fdv_adr) (Range(fdv_adr)->min) #define Max(fdv_adr) (Range(fdv_adr)->max) #define Vec(fdv_adr) (Range(fdv_adr)->vec) /* Chain / Propagation Mask */ #define CHAIN_NB_MIN 0 #define CHAIN_NB_MAX 1 #define CHAIN_NB_MIN_MAX 2 #define CHAIN_NB_DOM 3 #define CHAIN_NB_VAL 4 #define MASK_EMPTY 0 #define MASK_MIN 1 #define MASK_MAX 2 #define MASK_MIN_MAX 4 #define MASK_DOM 8 #define MASK_VAL 16 #define Has_Min_Mask(mask) ((mask) & MASK_MIN) #define Has_Max_Mask(mask) ((mask) & MASK_MAX) #define Has_Min_Max_Mask(mask) ((mask) & MASK_MIN_MAX) #define Has_Dom_Mask(mask) ((mask) & MASK_DOM) #define Has_Val_Mask(mask) ((mask) & MASK_VAL) #define Set_Min_Mask(mask) ((mask) |= MASK_MIN) #define Set_Max_Mask(mask) ((mask) |= MASK_MAX) #define Set_Min_Max_Mask(mask) ((mask) |= MASK_MIN_MAX) #define Set_Dom_Mask(mask) ((mask) |= MASK_DOM) #define Set_Val_Mask(mask) ((mask) |= MASK_VAL) /* Chain Record Frame */ #define CHAIN_RECORD_FRAME_SIZE 2 #define CF_Pointer(rec_adr) (*(WamWord **) &(rec_adr[0])) #define Next_Chain(rec_adr) (*(WamWord **) &(rec_adr[1])) /* Constraint Frame */ #define CONSTRAINT_FRAME_SIZE 3 #define OFFSET_OF_OPTIM_POINTER 1 /* this offset must correspond to >>> */ #define AF_Pointer(cf) (*(WamWord **) &(cf[0])) #define Optim_Pointer(cf) (*(PlULong **) &(cf[1])) /* >>> this cell */ #define Cstr_Address(cf) (*(PlLong (**)()) &(cf[2])) /* Miscellaneous */ #define ENV_VAR_VECTOR_MAX "VECTORMAX" #define DEFAULT_VECTOR_MAX 127 #define Fd_Variable_Is_Ground(fdv_adr) (Tag_Of(FD_Tag_Value(fdv_adr)) == INT) #define math_min(x, y) ((x) <= (y) ? (x) : (y)) #define math_max(x, y) ((x) >= (y) ? (x) : (y)) /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef FD_INST_FILE WamWord pl_vec_size; WamWord pl_vec_max_integer; #else extern WamWord pl_vec_size; extern WamWord pl_vec_max_integer; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ WamWord *Pl_Fd_Prolog_To_Fd_Var(WamWord arg_word, Bool pl_var_ok); Range *Pl_Fd_Prolog_To_Range(WamWord list_word); int Pl_Fd_Prolog_To_Value(WamWord arg_word); WamWord *Pl_Fd_Prolog_To_Array_Int(WamWord list_word); WamWord *Pl_Fd_Prolog_To_Array_Any(WamWord list_word); WamWord *Pl_Fd_Prolog_To_Array_Fdv(WamWord list_word, Bool pl_var_ok); void Pl_Fd_List_Int_To_Range(Range *range, WamWord list_word); WamWord *Pl_Fd_New_Variable_Interval(int min, int max); WamWord *Pl_Fd_New_Variable(void); WamWord *Pl_Fd_New_Variable_Range(Range *r); WamWord *Pl_Fd_New_Int_Variable(int n); WamWord *Pl_Fd_Create_C_Frame(PlLong (*cstr_fct) (), WamWord *AF, WamWord *fdv_adr, Bool optim2); void Pl_Fd_Add_Dependency(WamWord *fdv_adr, int chain_nb, WamWord *CF); void Pl_Fd_Add_List_Dependency(WamWord *array, int chain_nb, WamWord *CF); void Pl_Fd_Before_Add_Cstr(void); Bool Pl_Fd_After_Add_Cstr(Bool result_of_tell); void Pl_Fd_Stop_Constraint(WamWord *CF); Bool Pl_Fd_Tell_Value(WamWord *fdv_adr, int n); Bool Pl_Fd_Tell_Not_Value(WamWord *fdv_adr, int n); Bool Pl_Fd_Tell_Int_Range(WamWord *fdv_adr, Range *range); Bool Pl_Fd_Tell_Interv_Interv(WamWord *fdv_adr, int min, int max); Bool Pl_Fd_Tell_Range_Range(WamWord *fdv_adr, Range *range); Bool Pl_Fd_Tell_Interval(WamWord *fdv_adr, int min, int max); Bool Pl_Fd_Tell_Range(WamWord *fdv_adr, Range *range); void Pl_Fd_Display_Extra_Cstr(WamWord *fdv_adr); void Pl_Fd_Init_Solver0(void); void Pl_Fd_Reset_Solver0(void); Bool Pl_Fd_In_Interval(WamWord *fdv_adr, int min, int max); Bool Pl_Fd_In_Range(WamWord *fdv_adr, Range *range); Bool Pl_Fd_Assign_Value_Fast(WamWord *fdv_adr, int n); #define Pl_Fd_Assign_Value(fdv, n) Pl_Fd_Unify_With_Integer0(fdv, n) Bool Pl_Fd_Unify_With_Integer0(WamWord *fdv_adr, int n); Bool Pl_Fd_Unify_With_Fd_Var0(WamWord *fdv_adr1, WamWord *fdv_adr2); Bool Pl_Fd_Remove_Value(WamWord *fdv_adr, int n); Bool Pl_Fd_Use_Vector(WamWord *fdv_adr); Bool Pl_Fd_Check_For_Bool_Var(WamWord x_word); int Pl_Fd_Variable_Size0(WamWord *fdv_adr); int Pl_Fd_Copy_Variable0(WamWord *dst_adr, WamWord *fdv_adr); char *Pl_Fd_Variable_To_String0(WamWord *fdv_adr); #define Pl_Fd_New_Bool_Variable() Pl_Fd_New_Variable_Interval(0, 1) #define Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask) \ DEREF(fdv_word, word, tag_mask); \ if (tag_mask == TAG_REF_MASK) \ Pl_Err_Instantiation(); \ \ if (tag_mask != TAG_INT_MASK && tag_mask != TAG_FDV_MASK) \ Pl_Err_Type(pl_type_fd_variable, word) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/fd_range.c���������������������������������������������������������������0000644�0001750�0001750�00000124740�13021324543�015446� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : fd_range.c * * Descr.: FD Range Implementation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include "bool.h" #define FD_RANGE_FILE #include "engine_pl.h" #include "engine_fd.h" /*-------------------------------------------------------------------------* * The file fd_hook_range.h must contains the definition of: * * * * INTERVAL_MAX_INTEGER: an integer constant corresponding to the greatest * * value for intervals (i.e. 0..INTERVAL_MAX_INTEGER)* * * * pl_vec_max_integer : an integer variable corresponding to the greatest * * value for vectors (i.e. 0..pl_vec_max_integer). * * pl_vec_size : an integer variable corresponding to the size of a* * vector in words(i.e. pl_vec_max_integer/WORD_SIZE)* * (see Pl_Define_Vector_Size() function). * * * * RANGE_TOP_STACK : a long * variable corresponding to the top of the * * stack where are allocated the bit-vectors. * * The user must handle the (re)initialization of * * this pointer to a valid (read/write) memory area. * * Allocated vectors are never recovered, so the user* * should take care of reinitializations (GC) of the * * top of stack if needed. * * * * The following macros can be redefined: * * * * WORD_SIZE : a constant defining sizeof(void*) in bits (32/64).* *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define ALL_1 ((VecWord) -1) #define WRITE_BEGIN_RANGE "" #define WRITE_END_RANGE "" #define WRITE_LIMITS_SEPARATOR ".." #define WRITE_INTERVALS_SEPARATOR ":" #define WRITE_EXTRA_CSTR_SYMBOL "@" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*---------------------------------* * Auxiliary macros * *---------------------------------*/ #define math_min(x, y) ((x) <= (y) ? (x) : (y)) #define math_max(x, y) ((x) >= (y) ? (x) : (y)) /*-------------------------------------------------------------------------* * PL_DEFINE_VECTOR_SIZE * * * *-------------------------------------------------------------------------*/ void Pl_Define_Vector_Size(int max_val) { pl_vec_size = max_val / WORD_SIZE + 1; pl_vec_max_integer = pl_vec_size * WORD_SIZE - 1; } /*-------------------------------------------------------------------------* * PL_VECTOR_FROM_INTERVAL * * * *-------------------------------------------------------------------------*/ void Pl_Vector_From_Interval(Vector vec, int min, int max) { Vector w_min = vec + Word_No(min); Vector w_max = vec + Word_No(max); Vector end = vec + pl_vec_size; for (;;) if (vec == w_min) break; else *vec++ = 0; for (;;) if (vec > w_max) break; else *vec++ = ALL_1; for (;;) if (vec == end) break; else *vec++ = 0; *w_min &= ALL_1 << Bit_No(min); *w_max &= ALL_1 >> (WORD_SIZE - 1 - Bit_No(max)); } /*-------------------------------------------------------------------------* * PL_VECTOR_NB_ELEM * * * *-------------------------------------------------------------------------*/ int Pl_Vector_Nb_Elem(Vector vec) { register Vector end = vec + pl_vec_size; register int nb_elem = 0; do { nb_elem += Pl_Count_Set_Bits(*vec); vec++; } while (vec < end); return nb_elem; } /*-------------------------------------------------------------------------* * PL_VECTOR_ITH_ELEM * * * *-------------------------------------------------------------------------*/ int Pl_Vector_Ith_Elem(Vector vec, int i) { int vec_elem; if (i > 0) /* 1 <= i <= nb_elem */ { VECTOR_BEGIN_ENUM(vec, vec_elem); if (--i == 0) return vec_elem; VECTOR_END_ENUM; } return -1; } /*-------------------------------------------------------------------------* * PL_VECTOR_NEXT_AFTER * * * *-------------------------------------------------------------------------*/ int Pl_Vector_Next_After(Vector vec, int n) { int word_no; int bit_no; Vector start; Vector end; VecWord word; int bit; if (n >= 0) /* n >= 0 find next */ { if (n > pl_vec_max_integer) return -1; word_no = Word_No(n); bit_no = Bit_No(n) + 1; start = vec + word_no; word = (bit_no == WORD_SIZE) ? 0 : *start & ~(((PlLong)1 << bit_no) - 1); } else /* n < 0 find first */ { start = vec; word = *start; } end = vec + pl_vec_size; while (word == 0) { if (++start >= end) return -1; word = *start; } bit = Pl_Least_Significant_Bit(word); n = Word_No_And_Bit_No(start - vec, bit); return n; } /*-------------------------------------------------------------------------* * PL_VECTOR_NEXT_BEFORE * * * *-------------------------------------------------------------------------*/ int Pl_Vector_Next_Before(Vector vec, int n) { int word_no; int bit_no; Vector start; Vector end; VecWord word; int bit; if (n <= pl_vec_max_integer) /* n <= pl_vec_max_integer find previous */ { if (n < 0) return -1; word_no = Word_No(n); bit_no = Bit_No(n); end = vec + word_no; word = *end & (((PlLong)1 << bit_no) - 1); } else /* n > pl_vec_max_integer find last */ { end = vec + pl_vec_size - 1; word = *end; } start = vec; while (word == 0) { if (--end < start) return -1; word = *end; } bit = Pl_Most_Significant_Bit(word); n = Word_No_And_Bit_No(end - vec, bit); return n; } /*-------------------------------------------------------------------------* * PL_VECTOR_EMPTY * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Empty(Vector vec) { Vector end = vec + pl_vec_size; do *vec++ = 0; while (vec < end); } /*-------------------------------------------------------------------------* * PL_VECTOR_FULL * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Full(Vector vec) { Vector end = vec + pl_vec_size; do *vec++ = ALL_1; while (vec < end); } /*-------------------------------------------------------------------------* * PL_VECTOR_TEST_NULL_INTER * * * *-------------------------------------------------------------------------*/ Bool Pl_Vector_Test_Null_Inter(Vector vec, Vector vec1) { Vector end = vec + pl_vec_size; do if (*vec++ & *vec1++) return FALSE; while (vec < end); return TRUE; } /*-------------------------------------------------------------------------* * PL_VECTOR_COPY * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Copy(Vector vec, Vector vec1) { Vector end = vec + pl_vec_size; do *vec++ = *vec1++; while (vec < end); } /*-------------------------------------------------------------------------* * PL_VECTOR_UNION * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Union(Vector vec, Vector vec1) { Vector end = vec + pl_vec_size; do *vec++ |= *vec1++; while (vec < end); } /*-------------------------------------------------------------------------* * PL_VECTOR_INTER * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Inter(Vector vec, Vector vec1) { Vector end = vec + pl_vec_size; do *vec++ &= *vec1++; while (vec < end); } /*-------------------------------------------------------------------------* * PL_VECTOR_COMPL * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Compl(Vector vec) { Vector end = vec + pl_vec_size; do *vec = ~(*vec), vec++; while (vec < end); } /*-------------------------------------------------------------------------* * PL_VECTOR_ADD_VECTOR * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Add_Vector(Vector vec, Vector vec1) { Vector aux_vec; int vec_elem, vec_elem1; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); VECTOR_BEGIN_ENUM(aux_vec, vec_elem); VECTOR_BEGIN_ENUM(vec1, vec_elem1); x = vec_elem + vec_elem1; if (x > pl_vec_max_integer) goto loop1; Vector_Set_Value(vec, x); VECTOR_END_ENUM; loop1:; VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_SUB_VECTOR * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Sub_Vector(Vector vec, Vector vec1) { Vector aux_vec; int vec_elem, vec_elem1; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); VECTOR_BEGIN_ENUM(aux_vec, vec_elem); VECTOR_BEGIN_ENUM(vec1, vec_elem1); x = vec_elem - vec_elem1; if (x < 0) goto loop1; Vector_Set_Value(vec, x); VECTOR_END_ENUM; loop1:; VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_MUL_VECTOR * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Mul_Vector(Vector vec, Vector vec1) { Vector aux_vec; int vec_elem, vec_elem1; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); VECTOR_BEGIN_ENUM(aux_vec, vec_elem); VECTOR_BEGIN_ENUM(vec1, vec_elem1); x = vec_elem * vec_elem1; if (x > pl_vec_max_integer) goto loop1; Vector_Set_Value(vec, x); VECTOR_END_ENUM; loop1:; VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_DIV_VECTOR * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Div_Vector(Vector vec, Vector vec1) { Vector aux_vec; int vec_elem, vec_elem1; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); VECTOR_BEGIN_ENUM(aux_vec, vec_elem); if (vec_elem == 0) Vector_Set_Value(vec, 0); else { VECTOR_BEGIN_ENUM(vec1, vec_elem1); if (vec_elem1 != 0 && vec_elem % vec_elem1 == 0) { x = vec_elem / vec_elem1; Vector_Set_Value(vec, x); } VECTOR_END_ENUM; } VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_MOD_VECTOR * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Mod_Vector(Vector vec, Vector vec1) { Vector aux_vec; int vec_elem, vec_elem1; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); VECTOR_BEGIN_ENUM(aux_vec, vec_elem); VECTOR_BEGIN_ENUM(vec1, vec_elem1); if (vec_elem1 != 0) { x = vec_elem % vec_elem1; Vector_Set_Value(vec, x); } VECTOR_END_ENUM; VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_ADD_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Add_Value(Vector vec, int n) { int word_no; int bit_no; VecWord rem, rem1; int i, j; if (n >= 0) { word_no = Word_No(n); bit_no = Bit_No(n); if (word_no) { i = pl_vec_size - 1; j = pl_vec_size - 1 - word_no; while (j >= 0) vec[i--] = vec[j--]; while (i >= 0) vec[i--] = 0; } if (bit_no) { rem = 0; for (i = word_no; i < pl_vec_size; i++) { rem1 = vec[i] >> (WORD_SIZE - bit_no); vec[i] = (vec[i] << bit_no) | rem; rem = rem1; } } } else { word_no = Word_No(-n); bit_no = Bit_No(-n); if (word_no) { i = 0; j = word_no; while (j < pl_vec_size) vec[i++] = vec[j++]; while (i < pl_vec_size) vec[i++] = 0; } if (bit_no) { rem = 0; for (i = pl_vec_size - 1 - word_no; i >= 0; i--) { rem1 = vec[i] << (WORD_SIZE - bit_no); vec[i] = (vec[i] >> bit_no) | rem; rem = rem1; } } } } /*-------------------------------------------------------------------------* * PL_VECTOR_MUL_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Mul_Value(Vector vec, int n) { Vector aux_vec; int vec_elem; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); VECTOR_BEGIN_ENUM(aux_vec, vec_elem); x = vec_elem * n; if ((unsigned) x > (unsigned) pl_vec_max_integer) return; Vector_Set_Value(vec, x); VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_DIV_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Div_Value(Vector vec, int n) { Vector aux_vec; int vec_elem; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); if (n == 0) return; VECTOR_BEGIN_ENUM(aux_vec, vec_elem); if (vec_elem % n == 0) { x = vec_elem / n; Vector_Set_Value(vec, x); } VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_VECTOR_MOD_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Vector_Mod_Value(Vector vec, int n) { Vector aux_vec; int vec_elem; int x; Vector_Allocate(aux_vec); Pl_Vector_Copy(aux_vec, vec); Pl_Vector_Empty(vec); if (n == 0) return; VECTOR_BEGIN_ENUM(aux_vec, vec_elem); x = vec_elem % n; if ((unsigned) x <= (unsigned) pl_vec_max_integer) Vector_Set_Value(vec, x); VECTOR_END_ENUM; } /*-------------------------------------------------------------------------* * PL_RANGE_TEST_VALUE * * * *-------------------------------------------------------------------------*/ Bool Pl_Range_Test_Value(Range *range, int n) { int min = range->min; int max = range->max; if (n < min || n > max) return FALSE; if (Is_Interval(range) || n == min || n == max) return TRUE; return Vector_Test_Value(range->vec, n); } /*-------------------------------------------------------------------------* * PL_RANGE_TEST_NULL_INTER * * * *-------------------------------------------------------------------------*/ Bool Pl_Range_Test_Null_Inter(Range *range, Range *range1) { int swt, i; if (range->min > range1->max || range1->min > range->max) return TRUE; if (range->min == range1->min || range->min == range1->max || range->max == range1->min || range->max == range1->max) return FALSE; swt = (Is_Sparse(range) << 1) + Is_Sparse(range1); if (swt == 3) /* Sparse with Sparse */ return Pl_Vector_Test_Null_Inter(range1->vec, range->vec); if ((range->min >= range1->min && range->max >= range1->max) || (range1->min >= range->min && range1->max >= range->max)) return FALSE; if (swt == 0) /* Interval with Interval */ return FALSE; if (swt == 2) /* Sparse with Interval */ return Pl_Range_Test_Null_Inter(range1, range); /* Interval with Sparse */ if (range->min <= range1->min) return FALSE; for (i = range->min; i <= range->max; i++) if (Vector_Test_Value(range1->vec, i)) return FALSE; return TRUE; } /*-------------------------------------------------------------------------* * PL_RANGE_COPY * * * *-------------------------------------------------------------------------*/ void Pl_Range_Copy(Range *range, Range *range1) { range->extra_cstr = range1->extra_cstr; range->min = range1->min; range->max = range1->max; if (Is_Interval(range1)) range->vec = NULL; else { Vector_Allocate_If_Necessary(range->vec); Pl_Vector_Copy(range->vec, range1->vec); } } /*-------------------------------------------------------------------------* * PL_RANGE_NB_ELEM * * * *-------------------------------------------------------------------------*/ int Pl_Range_Nb_Elem(Range *range) { if (Is_Interval(range)) /* here range is not empty */ return range->max - range->min + 1; return Pl_Vector_Nb_Elem(range->vec); } /*-------------------------------------------------------------------------* * PL_RANGE_ITH_ELEM * * * *-------------------------------------------------------------------------*/ int Pl_Range_Ith_Elem(Range *range, int i) { int n; if (Is_Empty(range)) return -1; if (Is_Interval(range)) /* here range is not empty */ { /* 1 <= i <= nb_elem */ n = range->min + i - 1; return n < range->min || n > range->max ? -1 : n; } return Pl_Vector_Ith_Elem(range->vec, i); } /*-------------------------------------------------------------------------* * PL_RANGE_NEXT_AFTER * * * *-------------------------------------------------------------------------*/ int Pl_Range_Next_After(Range *range, int n) { if (Is_Empty(range)) return -1; if (Is_Interval(range)) /* here range is not empty */ { /* 1 <= i <= nb_elem */ if (n >= range->max) return -1; n++; if (n < range->min) n = range->min; return n; } return Pl_Vector_Next_After(range->vec, n); } /*-------------------------------------------------------------------------* * PL_RANGE_NEXT_BEFORE * * * *-------------------------------------------------------------------------*/ int Pl_Range_Next_Before(Range *range, int n) { if (Is_Empty(range)) return -1; if (Is_Interval(range)) /* here range is not empty */ { /* 1 <= i <= nb_elem */ if (n <= range->min) return -1; n--; if (n > range->max) n = range->max; return n; } return Pl_Vector_Next_Before(range->vec, n); } /*-------------------------------------------------------------------------* * PL_RANGE_BECOMES_SPARSE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Becomes_Sparse(Range *range) { Vector_Allocate_If_Necessary(range->vec); if (range->min < 0) range->min = 0; if ((range->extra_cstr = (range->max > pl_vec_max_integer))) range->max = pl_vec_max_integer; if (Is_Not_Empty(range)) Pl_Vector_From_Interval(range->vec, range->min, range->max); } /*-------------------------------------------------------------------------* * PL_RANGE_FROM_VECTOR * * * *-------------------------------------------------------------------------*/ void Pl_Range_From_Vector(Range *range) { Vector start; Vector end; int bit; start = range->vec - 1; end = range->vec + pl_vec_size; for (;;) if (*++start) break; else if (start >= end) { Set_To_Empty(range); return; } for (;;) if (*--end) break; bit = Pl_Least_Significant_Bit(*start); range->min = Word_No_And_Bit_No(start - range->vec, bit); bit = Pl_Most_Significant_Bit(*end); range->max = Word_No_And_Bit_No(end - range->vec, bit); } /*-------------------------------------------------------------------------* * PL_RANGE_SET_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Set_Value(Range *range, int n) { if (Is_Empty(range)) { Range_Init_Interval(range, n, n); return; } if (Is_Interval(range)) { if (n >= range->min && n <= range->max) return; if (n == range->min - 1) { range->min--; return; } if (n == range->max + 1) { range->max++; return; } Pl_Range_Becomes_Sparse(range); if ((unsigned) n <= (unsigned) pl_vec_max_integer) { Vector_Set_Value(range->vec, n); Pl_Range_From_Vector(range); } else range->extra_cstr = TRUE; return; } if ((unsigned) n > (unsigned) pl_vec_max_integer) { range->extra_cstr = TRUE; return; } Vector_Set_Value(range->vec, n); if (n < range->min || n > range->max) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_RESET_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Reset_Value(Range *range, int n) { if (Is_Empty(range) || n < range->min || n > range->max) return; if (range->min == range->max) { Set_To_Empty(range); return; } if (Is_Interval(range)) { if (n == range->min) { range->min++; return; } if (n == range->max) { range->max--; return; } Pl_Range_Becomes_Sparse(range); if ((unsigned) n <= (unsigned) pl_vec_max_integer) Vector_Reset_Value(range->vec, n); return; } if ((unsigned) n > (unsigned) pl_vec_max_integer) return; Vector_Reset_Value(range->vec, n); if (n == range->min || n == range->max) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_UNION * * * *-------------------------------------------------------------------------*/ void Pl_Range_Union(Range *range, Range *range1) { int swt = (Is_Sparse(range) << 1) + Is_Sparse(range1); Range r; Bool extra_cstr; if (swt == 0) /* Interval with Interval */ { if (Is_Not_Empty(range) && Is_Not_Empty(range1) && range1->min <= range->max + 1 && range->min <= range1->max + 1) { /* range->extra_cstr=FALSE; */ range->min = math_min(range->min, range1->min); range->max = math_max(range->max, range1->max); return; } Pl_Range_Becomes_Sparse(range); Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } else if (swt == 1) /* Interval with Sparse */ Pl_Range_Becomes_Sparse(range); else if (swt == 2) /* Sparse with Interval */ { Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ extra_cstr = range->extra_cstr | range1->extra_cstr; if (Is_Empty(range)) { Pl_Range_Copy(range, range1); range->extra_cstr = extra_cstr; return; } range->extra_cstr = extra_cstr; if (Is_Empty(range1)) return; range->min = math_min(range->min, range1->min); range->max = math_max(range->max, range1->max); Pl_Vector_Union(range->vec, range1->vec); } /*-------------------------------------------------------------------------* * PL_RANGE_INTER * * * *-------------------------------------------------------------------------*/ void Pl_Range_Inter(Range *range, Range *range1) { int swt = (Is_Sparse(range) << 1) + Is_Sparse(range1); Range r; if (swt == 0) /* Interval with Interval */ { /* range->extra_cstr=FALSE; */ range->min = math_max(range->min, range1->min); range->max = math_min(range->max, range1->max); return; } if (swt == 1) /* Interval with Sparse */ Pl_Range_Becomes_Sparse(range); else if (swt == 2) /* Sparse with Interval */ { Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ range->extra_cstr &= range1->extra_cstr; if (Is_Empty(range)) return; if (Is_Empty(range1)) { Set_To_Empty(range); return; } Pl_Vector_Inter(range->vec, range1->vec); Pl_Range_From_Vector(range); /* adjust min and max */ } /*-------------------------------------------------------------------------* * PL_RANGE_COMPL * * * *-------------------------------------------------------------------------*/ void Pl_Range_Compl(Range *range) { if (Is_Interval(range)) /* Interval */ { if (Is_Empty(range)) { range->min = 0; range->max = INTERVAL_MAX_INTEGER; return; } if (range->min <= 0) { if (range->max >= INTERVAL_MAX_INTEGER) Set_To_Empty(range); else { range->min = range->max + 1; range->max = INTERVAL_MAX_INTEGER; } return; } if (range->max >= INTERVAL_MAX_INTEGER) { range->max = range->min - 1; range->min = 0; return; } Pl_Range_Becomes_Sparse(range); } /* Sparse */ range->extra_cstr = TRUE; if (Is_Empty(range)) { range->min = 0; range->max = pl_vec_max_integer; Pl_Vector_Full(range->vec); } else { Pl_Vector_Compl(range->vec); Pl_Range_From_Vector(range); } } /*-------------------------------------------------------------------------* * PL_RANGE_ADD_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Add_Range(Range *range, Range *range1) { int swt = (Is_Sparse(range) << 1) + Is_Sparse(range1); Range r; if (Is_Empty(range)) return; if (Is_Empty(range1)) { Set_To_Empty(range); return; } if (swt == 0) /* Interval with Interval */ { /* range->extra_cstr=FALSE; */ range->min += range1->min; range->max += range1->max; return; } else if (swt == 1) /* Interval with Sparse */ Pl_Range_Becomes_Sparse(range); else if (swt == 2) /* Sparse with Interval */ { Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ Pl_Vector_Add_Vector(range->vec, range1->vec); range->min += range1->min; range->max += range1->max; range->extra_cstr |= (range1->extra_cstr | (range->max > pl_vec_max_integer)); if (range->extra_cstr || range->min < 0) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_SUB_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Sub_Range(Range *range, Range *range1) { int swt = (Is_Sparse(range) << 1) + Is_Sparse(range1); Range r; if (Is_Empty(range)) return; if (Is_Empty(range1)) { Set_To_Empty(range); return; } if (swt == 0) /* Interval with Interval */ { /* range->extra_cstr=FALSE; */ range->min -= range1->max; range->max -= range1->min; return; } else if (swt == 1) /* Interval with Sparse */ Pl_Range_Becomes_Sparse(range); else if (swt == 2) /* Sparse with Interval */ { Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ Pl_Vector_Sub_Vector(range->vec, range1->vec); range->min -= range1->max; range->max -= range1->min; range->extra_cstr |= range1->extra_cstr; if (range->extra_cstr || range->min < 0) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_MUL_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Mul_Range(Range *range, Range *range1) { Range r; if (Is_Empty(range)) return; if (Is_Empty(range1)) { Set_To_Empty(range); return; } if (Is_Interval(range)) Pl_Range_Becomes_Sparse(range); if (Is_Interval(range1)) { r.vec = NULL; Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ Pl_Vector_Mul_Vector(range->vec, range1->vec); range->extra_cstr |= range1->extra_cstr; Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_DIV_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Div_Range(Range *range, Range *range1) { Range r; if (Is_Empty(range)) return; if (Is_Empty(range1)) { Set_To_Empty(range); return; } if (Is_Interval(range)) Pl_Range_Becomes_Sparse(range); if (Is_Interval(range1)) { r.vec = NULL; Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ Pl_Vector_Div_Vector(range->vec, range1->vec); range->extra_cstr |= range1->extra_cstr; Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_MOD_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Mod_Range(Range *range, Range *range1) { Range r; if (Is_Empty(range)) return; if (Is_Empty(range1)) { Set_To_Empty(range); return; } if (Is_Interval(range)) Pl_Range_Becomes_Sparse(range); if (Is_Interval(range1)) { r.vec = NULL; Pl_Range_Copy(&r, range1); /* we cannot modify range1 */ range1 = &r; Pl_Range_Becomes_Sparse(range1); } /* Sparse with Sparse */ Pl_Vector_Mod_Vector(range->vec, range1->vec); range->extra_cstr |= range1->extra_cstr; Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_ADD_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Add_Value(Range *range, int n) { if (n == 0 || Is_Empty(range)) return; if (Is_Interval(range)) /* Interval */ { range->min += n; range->max += n; return; } /* Sparse */ Pl_Vector_Add_Value(range->vec, n); range->min += n; range->max += n; range->extra_cstr |= (range->max > pl_vec_max_integer); if (range->extra_cstr || range->min < 0) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_MUL_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Mul_Value(Range *range, int n) { if (n == 1 || Is_Empty(range)) return; if (Is_Interval(range)) /* Interval */ Pl_Range_Becomes_Sparse(range); /* Sparse */ Pl_Vector_Mul_Value(range->vec, n); range->min = range->min * n; range->max = range->max * n; range->extra_cstr |= (range->max > pl_vec_max_integer); if (range->extra_cstr) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_DIV_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Div_Value(Range *range, int n) { if (n == 1 || Is_Empty(range)) return; if (Is_Interval(range)) /* Interval */ Pl_Range_Becomes_Sparse(range); /* Sparse */ Pl_Vector_Div_Value(range->vec, n); range->min = (range->min + n - 1) / n; range->max = range->max / n; range->extra_cstr |= (range->max > pl_vec_max_integer); if (range->extra_cstr) Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_MOD_VALUE * * * *-------------------------------------------------------------------------*/ void Pl_Range_Mod_Value(Range *range, int n) { Range aux; if (Is_Empty(range)) return; if (n < 0) n = -n; if (Is_Interval(range)) /* Interval */ { if (range->min >= 0) { if (range->max - range->min + 1 >= n) { range->min = 0; range->max = n - 1; return; } range->min = range->min % n; range->max = range->max % n; if (range->min > range->max) { Range_Init_Interval(&aux, 0, range->max); range->max = n - 1; Pl_Range_Union(range, &aux); } return; } if (range->max <= 0) { if (range->max - range->min + 1 >= n) { range->min = -(n - 1); range->max = 0; return; } range->min = range->min % n; range->max = range->max % n; if (range->min > range->max) /* Only 0 will remain in the */ { /* range due to the changeover */ /* from Interval to Sparse */ Range_Init_Interval(&aux, -(n - 1), range->max); range->max = 0; Pl_Range_Union(range, &aux); } return; } /* Here range->min < 0 and range->max > 0 */ range->min = math_max(range->min, -n + 1); range->max = math_min(range->max, n - 1); return; } /* Sparse */ Pl_Vector_Mod_Value(range->vec, n); Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_RANGE_TO_STRING * * * *-------------------------------------------------------------------------*/ char * Pl_Range_To_String(Range *range) { int vec_elem; int limit1 = -1; int limit2; static char buff[4096]; if (Is_Empty(range)) { strcpy(buff, "<empty range>"); return buff; } if (range->min == range->max) { sprintf(buff, "{%d}", range->min); return buff; } if (Is_Interval(range)) { sprintf(buff, "%s%d%s%d%s", WRITE_BEGIN_RANGE, range->min, WRITE_LIMITS_SEPARATOR, range->max, WRITE_END_RANGE); return buff; } sprintf(buff, "%s", WRITE_BEGIN_RANGE); VECTOR_BEGIN_ENUM(range->vec, vec_elem); if (limit1 == -1) limit1 = limit2 = vec_elem; else if (vec_elem == limit2 + 1) limit2 = vec_elem; else { if (limit2 == limit1) sprintf(buff + strlen(buff), "%d%s", limit1, WRITE_INTERVALS_SEPARATOR); else sprintf(buff + strlen(buff), "%d%s%d%s", limit1, WRITE_LIMITS_SEPARATOR, limit2, WRITE_INTERVALS_SEPARATOR); limit1 = limit2 = vec_elem; } VECTOR_END_ENUM; if (limit1 != -1) { if (limit2 == limit1) sprintf(buff + strlen(buff), "%d%s", limit1, WRITE_END_RANGE); else sprintf(buff + strlen(buff), "%d%s%d%s", limit1, WRITE_LIMITS_SEPARATOR, limit2, WRITE_END_RANGE); } if (range->extra_cstr) sprintf(buff + strlen(buff), "%s", WRITE_EXTRA_CSTR_SYMBOL); return buff; } ��������������������������������gprolog-1.4.5/src/EngineFD/.gitignore���������������������������������������������������������������0000644�0001750�0001750�00000000023�13021324543�015510� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile TestRange �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/fd_unify.fd��������������������������������������������������������������0000644�0001750�0001750�00000001524�13021324543�015645� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------*/ /* C Run-Time (FD Solver) Daniel Diaz - 1998 */ /* FD instruction implementation (unification) - FD part */ /* */ /* fd_unify.fd Copyright (C) 1998, INRIA France */ /*-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------*/ /* UNIFICATION */ /* */ /*-------------------------------------------------------------------------*/ pl_unify_x_y(fdv X,fdv Y) { start X in dom(Y) start Y in dom(X) } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/engine_fd.h��������������������������������������������������������������0000644�0001750�0001750�00000005402�13021324543�015615� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : engine_fd.h * * Descr.: general header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "fd_range.h" #include "fd_inst.h" ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/fd_hook_range.h����������������������������������������������������������0000644�0001750�0001750�00000005746�13021324543�016477� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : fd_hook_range.h * * Descr.: FD Range Implementation - customizable header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define RANGE_TOP_STACK CS #define INTERVAL_MAX_INTEGER ((int)(((PlLong)1<<(32-TAG_SIZE-1))-1)) /* only 32 bits (even on 64 bits machine) */ ��������������������������gprolog-1.4.5/src/EngineFD/fd_inst.c����������������������������������������������������������������0000644�0001750�0001750�00000132752�13021324543�015331� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : fd_inst.c * * Descr.: FD instruction implementation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #define FD_INST_FILE #define OBJ_INIT Fd_Inst_Initializer #include "engine_pl.h" #include "engine_fd.h" #include "bips_pl.h" #if 0 #define DEBUG_CHECK_DATES_AND_QUEUE #endif /*---------------------------------* * Constants * *---------------------------------*/ #define MSG_VECTOR_TOO_SMALL "Warning: Vector too small - maybe lost solutions (FD Var:_%ld)\n" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord *TP; static WamWord dummy_fd_var[FD_VARIABLE_FRAME_SIZE]; static PlULong DATE; /* NB: PlLong/PlULong have the same size as a WamWord (intptr_t) */ /* * When a constraint X in ... is added the following sequence is executed: * Pl_Fd_Before_Add_Cstr (init the queue) * compute the range/interval to restrict the variable X * Pl_Fd_Tell_...(X, range/interval) (restrict X) * these functions call All_Propagations to add constraint depending on X to the queue * Pl_Fd_After_Add_Cstr (execute constraints in the queue) * * NB: Pl_Fd_Tell_... functions must be called inside Pl_Fd_Before_Add_Cstr / Pl_Fd_After_Add_Cstr */ /* * FD_INT_Date(fdv_adr): is the date at which the FD var has been instantiated * Optim #2: if a var has been instantiated before the post of the current * constraint it is not necessary to reexecute it (in the propagation phase). * * For this we use a counter DATE (an unsigned) ranging from 1 to 0xFFFF...F * - value 0 is reserved for DATE_NEVER (never reexecute it) * - value 1 is reserved for DATE_ALWAYS (always reexecute it) * e.g. used as long as an FD variable is not instantiated * * NB: it is not a problem if DATE == 1 (see test below) * ideally we would like that all DATE == DATE_ALWAYS * * A X in r constraint on X maintains a pointer to the FD_INT_Date(X) * (see Optim_Pointer(cf)). The main test is as follows: * * if *Optim_Pointer(cf) != both DATE and DATE_ALWAYS * skip the constraint (optim #2 or constraint stopped) * else * execute the constraint * * For some constraints optim #2 is invalid: point to optim2_date_always * To stop a constraint: point to optim2_date_never * * Since DATE is never decremented, for long computations it can overflow. * In that case DATE restarts from 2, 3,... (rotation). * Due to rotations, it is no longer possible to use tests like (xxx < DATE) * * This prevents to use DATE to test if a variable is already in the queue. * * We now mark variables which are in the queue using the Queue_Propag_Mask * (which is the mask of all chains to reexecute for this var). * if Queue_Propag_Mask == 0 the var is not in the queue (else it is). * * When a constraint is told, in case of success, the queue has been * fully scanned and all variable are unmarked (i.e. no longer in the queue). * However, when a failure occurs in the propagation phase, some vars remain * in the queue (marked). Thus Clear_Queue() is called to clean the queue. * * NB: in 1.4.2, Clear_Queue() was called in Pl_Fd_Before_Add_Cstr() to clear * the variables remaining in the queue (i.e. of the previous constraint post). * But this does not work if FD vars are created/restored (choice-point) * between a failure (remaining vars in the queue) and the next Clear_Queue(). * * About propagation phase (Pl_Fd_After_Add_Cstr). The queue of constraint * having constraints to reconsider (reexecute) is handled as follows: * Queue_Next_Fdv_Adr(dummy_fd_var) points to the first variable. * TP points to the last variable in queue * * The queue is empty if TP == dummy_fd_var. Constraints are added at the * end modifying TP. * * When a variable X is taken into account, all needed chains are traversed * and constraints depending on X are reexecuted. This can in turn trigger a * reconsideration of X. It is important to not re-add X to the queue (else * TP will be modified to X and since BP = TP = X the propagation algorithm * considers everything is done). We use MASK_TO_KEEP_IN_QUEUE to ensure X * continues to be considered in the queue and to clear the chains to * propagate for it. This gives in the propagation loop: * * X = BP * propag = Queue_Propag_Mask(X); * Queue_Propag_Mask(X) = MASK_TO_KEEP_IN_QUEUE * for each cstr C in a chain of X wrt to propag * reexecute C (NB: skip it depending on DATE for optim #2, see above) * Queue_Propag_Mask(X) &= (MASK_TO_KEEP_IN_QUEUE - 1) * if (Queue_Propag_Mask(fdv_adr) == 0) { ie. no longer in the queue * if (BP == TP) * success * BP = Queue_Next_Fdv_Adr(BP); * } * * NB: if a constraint reexecution fails (in the above loop), X has the * MASK_TO_KEEP_IN_QUEUE set. This is not a problem since at the next * constraint post the queue is cleared assigning 0 to each Queue_Propag_Mask. */ #define DATE_NEVER 0 #define DATE_ALWAYS 1 static PlULong optim2_date_never = DATE_NEVER; /* must be always != any DATE */ static PlULong optim2_date_always = DATE_ALWAYS; /* must be considered as == all DATE */ void (*pl_fd_init_solver) () = Pl_Fd_Init_Solver0; /* overwrite var of if_no_fd.c */ void (*pl_fd_reset_solver) () = Pl_Fd_Reset_Solver0; /* overwrite var of if_no_fd.c */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void All_Propagations(WamWord *fdv_adr, int propag); static void Clear_Queue(void); /*---------------------------------* * Auxiliary engine macros * *---------------------------------*/ #define FD_Word_Needs_Trailing(adr) ((adr) < CSB(B)) #define FD_Bind_OV(adr, word) \ do \ { \ if (FD_Word_Needs_Trailing(adr)) \ Trail_OV(adr); \ *(adr) = (word); \ } \ while (0) #define Trail_Fd_Int_Variable_If_Necessary(fdv_adr) \ do \ { \ if (FD_Word_Needs_Trailing(&FD_Tag_Value(fdv_adr))) \ { \ Trail_OV(&FD_Tag_Value(fdv_adr)); \ Trail_OV(&FD_INT_Date(fdv_adr)); \ Trail_Range_If_Necessary(fdv_adr); \ } \ } \ while (0) #define Trail_Range_If_Necessary(fdv_adr) \ do \ { \ if (Range_Stamp(fdv_adr) != STAMP) \ { \ Trail_MV(fdv_adr + OFFSET_RANGE, RANGE_SIZE); \ if (Is_Sparse(Range(fdv_adr))) \ Trail_MV((WamWord *) Vec(fdv_adr), pl_vec_size); \ \ Range_Stamp(fdv_adr) = STAMP; \ } \ } \ while (0) #define Trail_Chains_If_Necessary(fdv_adr) \ do \ { \ if (Chains_Stamp(fdv_adr) != STAMP) \ { \ Trail_MV(fdv_adr + OFFSET_CHAINS, CHAINS_SIZE); \ Chains_Stamp(fdv_adr) = STAMP; \ } \ } \ while (0) #define Update_Range_From_Int(fdv_adr, n, propag) \ do \ { \ propag = MASK_EMPTY; \ \ Trail_Fd_Int_Variable_If_Necessary(fdv_adr); \ Nb_Elem(fdv_adr) = 1; \ \ Set_Min_Max_Mask(propag); \ Set_Dom_Mask(propag); \ Set_Val_Mask(propag); \ \ if (Min(fdv_adr) != n) \ { \ Min(fdv_adr) = n; \ Set_Min_Mask(propag); \ } \ \ if (Max(fdv_adr) != n) \ { \ Max(fdv_adr) = n; \ Set_Max_Mask(propag); \ } \ \ Vec(fdv_adr) = NULL; \ FD_Tag_Value(fdv_adr) = Tag_INT(n); \ FD_INT_Date(fdv_adr) = DATE; \ } \ while (0) #define Update_Interval_From_Interval(fdv_adr, nb_elem, min, max, propag) \ do \ { \ propag = MASK_EMPTY; \ \ if (Nb_Elem(fdv_adr) != nb_elem) \ { \ Trail_Range_If_Necessary(fdv_adr); \ Nb_Elem(fdv_adr) = nb_elem; \ \ Set_Min_Max_Mask(propag); \ Set_Dom_Mask(propag); \ \ if (Min(fdv_adr) != min) \ { \ Min(fdv_adr) = min; \ Set_Min_Mask(propag); \ } \ \ if (Max(fdv_adr) != max) \ { \ Max(fdv_adr) = max; \ Set_Max_Mask(propag); \ } \ } \ } \ while (0) #define Update_Range_From_Range(fdv_adr, nb_elem, range, propag) \ do \ { \ Range *r = Range(fdv_adr); \ \ propag = MASK_EMPTY; \ \ if (Min(fdv_adr) != (range)->min) \ { \ Set_Min_Mask(propag); \ Set_Min_Max_Mask(propag); \ } \ \ if (Max(fdv_adr) != (range)->max) \ { \ Set_Max_Mask(propag); \ Set_Min_Max_Mask(propag); \ } \ \ if (Nb_Elem(fdv_adr) != nb_elem) \ Set_Dom_Mask(propag); \ \ if (propag || (Is_Interval(r) && Is_Sparse(range))) \ { \ Trail_Range_If_Necessary(fdv_adr); \ Nb_Elem(fdv_adr) = nb_elem; \ Pl_Range_Copy(r, range); \ } \ else if (r->extra_cstr != (range)->extra_cstr) \ { \ FD_Bind_OV((WamWord *) &(r->extra_cstr), (range->extra_cstr)); \ Set_Dom_Mask(propag); \ } \ } \ while (0) #ifdef DEBUG_CHECK_DATES_AND_QUEUE static WamWord *last_fdv_avr = NULL; /* a list of all FD vars (see Pl_Fd_New_Variable) */ static void Check_Queue_Consistency(void); #endif /*-------------------------------------------------------------------------* * FD_INST_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Fd_Inst_Initializer(void) { pl_fd_init_solver = Pl_Fd_Init_Solver0; pl_fd_reset_solver = Pl_Fd_Reset_Solver0; } /*-------------------------------------------------------------------------* * PL_FD_INIT_SOLVER0 * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Init_Solver0(void) { char *p; int max_val; p = (char *) getenv(ENV_VAR_VECTOR_MAX); if (p && *p) sscanf(p, "%d", &max_val); else max_val = DEFAULT_VECTOR_MAX; Pl_Define_Vector_Size(max_val); Pl_Fd_Reset_Solver0(); pl_fd_unify_with_integer = Pl_Fd_Unify_With_Integer0; pl_fd_unify_with_fd_var = Pl_Fd_Unify_With_Fd_Var0; pl_fd_variable_size = Pl_Fd_Variable_Size0; pl_fd_copy_variable = Pl_Fd_Copy_Variable0; pl_fd_variable_to_string = Pl_Fd_Variable_To_String0; } /*-------------------------------------------------------------------------* * PL_FD_RESET_SOLVER0 * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Reset_Solver0(void) { STAMP = 0; DATE = 1; TP = dummy_fd_var; /* the queue is empty */ } /*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_FD_VAR * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Fd_Var(WamWord arg_word, Bool pl_var_ok) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; DEREF(arg_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { if (!pl_var_ok) Pl_Err_Instantiation(); adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); return fdv_adr; } if (tag_mask == TAG_INT_MASK) return Pl_Fd_New_Int_Variable(UnTag_INT(word)); if (tag_mask != TAG_FDV_MASK) Pl_Err_Type(pl_type_fd_variable, word); return UnTag_FDV(word); } /*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_RANGE * * * *-------------------------------------------------------------------------*/ Range * Pl_Fd_Prolog_To_Range(WamWord list_word) { Range *range; range = (Range *) CS; CS += sizeof(Range) / sizeof(WamWord); range->vec = NULL; Pl_Fd_List_Int_To_Range(range, list_word); return range; } /*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_VALUE * * * *-------------------------------------------------------------------------*/ int Pl_Fd_Prolog_To_Value(WamWord arg_word) { PlLong v = Pl_Rd_Integer_Check(arg_word); /* conversion PlLong -> int (Fd only uses int) */ if (v < -INTERVAL_MAX_INTEGER) v = -INTERVAL_MAX_INTEGER; if (v > INTERVAL_MAX_INTEGER) v = INTERVAL_MAX_INTEGER; return (int) v; } /*-------------------------------------------------------------------------* * PL_FD_LIST_INT_TO_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Fd_List_Int_To_Range(Range *range, WamWord list_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; WamWord val; int n = 0; save_list_word = list_word; range->extra_cstr = FALSE; Vector_Allocate_If_Necessary(range->vec); Pl_Vector_Empty(range->vec); for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); val = Pl_Fd_Prolog_To_Value(Car(lst_adr)); if ((unsigned) val > (unsigned) pl_vec_max_integer) range->extra_cstr = TRUE; else { Vector_Set_Value(range->vec, val); n++; } list_word = Cdr(lst_adr); } if (n == 0) Set_To_Empty(range); else Pl_Range_From_Vector(range); } /*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_ARRAY_INT * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Array_Int(WamWord list_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; WamWord val; int n = 0; WamWord *array; WamWord *save_array; array = CS; save_list_word = list_word; save_array = array; array++; /* +1 for the nb of elems */ for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_integer, word); val = UnTag_INT(word); *array++ = val; n++; list_word = Cdr(lst_adr); } *save_array = n; CS = array; return save_array; } /*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_ARRAY_ANY * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Array_Any(WamWord list_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; int n = 0; WamWord *array; WamWord *save_array; array = CS; save_list_word = list_word; save_array = array; array++; /* +1 for the nb of elems */ for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); *array++ = Car(lst_adr); n++; list_word = Cdr(lst_adr); } *save_array = n; CS = array; return save_array; } /*-------------------------------------------------------------------------* * PL_FD_PROLOG_TO_ARRAY_FDV * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Prolog_To_Array_Fdv(WamWord list_word, Bool pl_var_ok) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; int n = 0; WamWord *save_array; WamWord *array; /* compute the length of the list to */ /* reserve space in the heap for the */ /* array before pushing new FD vars. */ save_list_word = list_word; for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask != TAG_LST_MASK) break; lst_adr = UnTag_LST(word); n++; list_word = Cdr(lst_adr); } array = CS; CS = CS + n + 1; list_word = save_list_word; save_array = array; array++; /* +1 for the nb of elems */ for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); *array++ = (WamWord) Pl_Fd_Prolog_To_Fd_Var(Car(lst_adr), pl_var_ok); list_word = Cdr(lst_adr); } *save_array = n; return save_array; } /*-------------------------------------------------------------------------* * PL_FD_CREATE_C_FRAME * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_Create_C_Frame(PlLong (*cstr_fct) (), WamWord *AF, WamWord *fdv_adr, Bool optim2) { WamWord *CF = CS; AF_Pointer(CF) = AF; Optim_Pointer(CF) = (optim2 && fdv_adr) ? &FD_INT_Date(fdv_adr) : &optim2_date_always; Cstr_Address(CF) = cstr_fct; /* if ground Nb_Cstr not allocated (Fd_Int_Frame) */ if (fdv_adr && !Fd_Variable_Is_Ground(fdv_adr)) Nb_Cstr(fdv_adr)++; CS += CONSTRAINT_FRAME_SIZE; return CF; } /*-------------------------------------------------------------------------* * PL_FD_ADD_DEPENDENCY * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Add_Dependency(WamWord *fdv_adr, int chain_nb, WamWord *CF) { WamWord **chain_adr; if (Fd_Variable_Is_Ground(fdv_adr)) return; Trail_Chains_If_Necessary(fdv_adr); Chains_Mask(fdv_adr) |= (1 << chain_nb); chain_adr = (&Chain_Min(fdv_adr) + chain_nb); CF_Pointer(CS) = CF; Next_Chain(CS) = *chain_adr; *chain_adr = CS; CS += CHAIN_RECORD_FRAME_SIZE; } /*-------------------------------------------------------------------------* * PL_FD_ADD_LIST_DEPENDENCY * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Add_List_Dependency(WamWord *array, int chain_nb, WamWord *CF) { int n = *array++; while (n--) Pl_Fd_Add_Dependency((WamWord *) (*array++), chain_nb, CF); } /*-------------------------------------------------------------------------* * PL_FD_NEW_VARIABLE_INTERVAL * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_New_Variable_Interval(int min, int max) { WamWord *fdv_adr; #ifdef DEBUG_CHECK_DATES_AND_QUEUE Trail_OV(&last_fdv_avr); /* reserve a cell just before the FD var to link prev FD var (stack) */ *CS = (WamWord) last_fdv_avr; last_fdv_avr = CS++; #endif fdv_adr = CS; FD_Tag_Value(fdv_adr) = Tag_FDV(fdv_adr); FD_INT_Date(fdv_adr) = DATE_ALWAYS; /* must be awoken as long as tag == FDV */ Queue_Propag_Mask(fdv_adr) = 0; Queue_Next_Fdv_Adr(fdv_adr) = NULL; Range_Stamp(fdv_adr) = STAMP; Nb_Elem(fdv_adr) = max - min + 1; Range_Init_Interval(Range(fdv_adr), min, max); Chains_Stamp(fdv_adr) = STAMP; Nb_Cstr(fdv_adr) = 0; Chains_Mask(fdv_adr) = MASK_EMPTY; Chain_Min(fdv_adr) = Chain_Max(fdv_adr) = Chain_Min_Max(fdv_adr) = NULL; Chain_Dom(fdv_adr) = Chain_Val(fdv_adr) = NULL; CS += FD_VARIABLE_FRAME_SIZE; return fdv_adr; } /*-------------------------------------------------------------------------* * PL_FD_NEW_VARIABLE * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_New_Variable(void) { return Pl_Fd_New_Variable_Interval(0, INTERVAL_MAX_INTEGER); } /*-------------------------------------------------------------------------* * PL_FD_NEW_VARIABLE_RANGE * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_New_Variable_Range(Range *r) { WamWord *fdv_adr = Pl_Fd_New_Variable(); Pl_Range_Copy(Range(fdv_adr), r); Nb_Elem(fdv_adr) = Pl_Range_Nb_Elem(r); return fdv_adr; } /*-------------------------------------------------------------------------* * PL_FD_NEW_INT_VARIABLE * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Fd_New_Int_Variable(int n) { WamWord *fdv_adr = CS; FD_Tag_Value(fdv_adr) = Tag_INT(n); FD_INT_Date(fdv_adr) = DATE_NEVER; Queue_Propag_Mask(fdv_adr) = 0; Queue_Next_Fdv_Adr(fdv_adr) = NULL; Range_Stamp(fdv_adr) = STAMP; Nb_Elem(fdv_adr) = 1; Range_Init_Interval(Range(fdv_adr), n, n); CS += FD_INT_VARIABLE_FRAME_SIZE; return fdv_adr; } /*-------------------------------------------------------------------------* * PL_FD_BEFORE_ADD_CSTR * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Before_Add_Cstr(void) { #ifdef DEBUG_CHECK_DATES_AND_QUEUE PlULong last_date = DATE; static int nb_rot = 0; DATE += (PlULong) -1 / 10000000; /* for rotations (decrease denom for more often) */ if (DATE < last_date) printf(">>>>>>>>>>>>>>> ROTATION OCCURS: #%d\n", ++nb_rot); #else DATE++; #endif if (DATE == DATE_NEVER) /* reserve DATE_NEVER (i.e. 0) */ DATE++; /* NB: it is not a problem if DATE == DATE_ALWAYS (i.e. 1) */ TP = dummy_fd_var; /* the queue is empty */ #ifdef DEBUG_CHECK_DATES_AND_QUEUE Check_Queue_Consistency(); #endif } #ifdef DEBUG_CHECK_DATES_AND_QUEUE /*-------------------------------------------------------------------------* * CHECK_QUEUE_CONSISTENCY * * * *-------------------------------------------------------------------------*/ static void Check_Queue_Consistency(void) { WamWord *fdv_adr = last_fdv_avr; WamWord *prev; while(fdv_adr != NULL) { prev = (WamWord *) (*fdv_adr); /* link to (cell - 1 of) previous FD var */ fdv_adr++; /* FD var is just after stack previous links */ #if 0 printf("Checking var:_%ld (%p)\n", Cstr_Offset(fdv_adr), fdv_adr); #endif if (Is_Var_In_Queue(fdv_adr)) printf("ERROR QUEUE should be empty but contains var:_#%ld (%p)\n", Cstr_Offset(fdv_adr), fdv_adr); fdv_adr = prev; } } #endif /*-------------------------------------------------------------------------* * CLEAR_QUEUE * * * *-------------------------------------------------------------------------*/ static void Clear_Queue(void) { WamWord *BP; WamWord *fdv_adr; if (TP == dummy_fd_var) /* empty ? */ return; BP = Queue_Next_Fdv_Adr(dummy_fd_var); for(;;) { fdv_adr = (WamWord *) BP; Del_Var_From_Queue(fdv_adr); if (BP == TP) break; BP = Queue_Next_Fdv_Adr(BP); } TP = dummy_fd_var; /* empty */ } /*-------------------------------------------------------------------------* * PL_FD_TELL_VALUE * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Value(WamWord *fdv_adr, int n) { int propag; if (!Pl_Range_Test_Value(Range(fdv_adr), n)) { if (Extra_Cstr(fdv_adr) && n > pl_vec_max_integer) Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } if (Fd_Variable_Is_Ground(fdv_adr)) return TRUE; Update_Range_From_Int(fdv_adr, n, propag); All_Propagations(fdv_adr, propag); return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_TELL_NOT_VALUE * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Not_Value(WamWord *fdv_adr, int n) { Range *r; int min, max; int propag; start: r = Range(fdv_adr); if (!Pl_Range_Test_Value(r, n)) return TRUE; if (Fd_Variable_Is_Ground(fdv_adr)) { if (Extra_Cstr(fdv_adr)) Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } min = r->min; max = r->max; if (Is_Interval(r) && n != min && n != max) { if (min > pl_vec_max_integer) { Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } if (min == pl_vec_max_integer) { Pl_Fd_Display_Extra_Cstr(fdv_adr); Update_Range_From_Int(fdv_adr, min, propag); All_Propagations(fdv_adr, propag); return TRUE; } Trail_Range_If_Necessary(fdv_adr); Pl_Range_Becomes_Sparse(r); Nb_Elem(fdv_adr) = r->max - r->min + 1; if (r->extra_cstr) /* the max has been changed */ { propag = MASK_EMPTY; Set_Max_Mask(propag); Set_Min_Max_Mask(propag); Set_Dom_Mask(propag); All_Propagations(fdv_adr, propag); } goto start; } if (Nb_Elem(fdv_adr) == 2) { if (n == min) min = max; Update_Range_From_Int(fdv_adr, min, propag); goto do_propag; } /* here if sparse OR n==min OR n==max */ Trail_Range_If_Necessary(fdv_adr); propag = MASK_EMPTY; Set_Dom_Mask(propag); if (Is_Sparse(r)) Vector_Reset_Value(r->vec, n); Nb_Elem(fdv_adr)--; if (n == min) { Set_Min_Mask(propag); Set_Min_Max_Mask(propag); r->min = (Is_Interval(r)) ? n + 1 : Pl_Vector_Next_After(r->vec, n); goto do_propag; } if (n == max) { Set_Max_Mask(propag); Set_Min_Max_Mask(propag); r->max = (Is_Interval(r)) ? n - 1 : Pl_Vector_Next_Before(r->vec, n); goto do_propag; } do_propag: All_Propagations(fdv_adr, propag); return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_TELL_INT_RANGE * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Int_Range(WamWord *fdv_adr, Range *range) { int n = Min(fdv_adr); if (!Pl_Range_Test_Value(range, n)) { if (n > pl_vec_max_integer && range->extra_cstr) Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_TELL_INTERV_INTERV * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Interv_Interv(WamWord *fdv_adr, int min, int max) { int nb_elem; int propag; int min1, max1; min1 = Min(fdv_adr); max1 = Max(fdv_adr); min = math_max(min, min1); max = math_min(max, max1); if (min > max) /* detects also if the initial */ return FALSE; /* interval (min, max) was empty */ if (min == max) Update_Range_From_Int(fdv_adr, min, propag); else { nb_elem = max - min + 1; Update_Interval_From_Interval(fdv_adr, nb_elem, min, max, propag); } if (propag) All_Propagations(fdv_adr, propag); return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_TELL_RANGE_RANGE * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Range_Range(WamWord *fdv_adr, Range *range) { int nb_elem; int propag; WamWord *save_CS = CS; if (range->vec) CS = (WamWord *) range->vec; CS += pl_vec_size; Pl_Range_Inter(range, Range(fdv_adr)); CS = save_CS; if (Is_Empty(range)) { if (range->extra_cstr) Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } if (range->min == range->max) { if (range->extra_cstr) Pl_Fd_Display_Extra_Cstr(fdv_adr); Update_Range_From_Int(fdv_adr, range->min, propag); } else { nb_elem = Pl_Range_Nb_Elem(range); Update_Range_From_Range(fdv_adr, nb_elem, range, propag); } if (propag) All_Propagations(fdv_adr, propag); return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_TELL_INTERVAL * * * * Called by fd_to_c.h * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Interval(WamWord *fdv_adr, int min, int max) { int n; Range range; if (Fd_Variable_Is_Ground(fdv_adr)) { n = Min(fdv_adr); return (n >= min && n <= max); /* also detects if initial range is empty */ } if (Is_Sparse(Range(fdv_adr))) { Range_Init_Interval(&range, min, max); return Pl_Fd_Tell_Range_Range(fdv_adr, &range); } return Pl_Fd_Tell_Interv_Interv(fdv_adr, min, max); } /*-------------------------------------------------------------------------* * PL_FD_TELL_RANGE * * * * Called by fd_to_c.h * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Tell_Range(WamWord *fdv_adr, Range *range) { if (Fd_Variable_Is_Ground(fdv_adr)) return Pl_Fd_Tell_Int_Range(fdv_adr, range); return Pl_Fd_Tell_Range_Range(fdv_adr, range); } /*-------------------------------------------------------------------------* * ALL_PROPAGATIONS * * * *-------------------------------------------------------------------------*/ static void All_Propagations(WamWord *fdv_adr, int propag) { if (propag &= Chains_Mask(fdv_adr)) { /* here propag != 0 */ if (!Is_Var_In_Queue(fdv_adr)) /* not yet in the queue */ { Queue_Propag_Mask(fdv_adr) = propag; /* setting propag != 0 adds the var to the queue */ Queue_Next_Fdv_Adr(TP) = fdv_adr; TP = fdv_adr; } else /* already in the queue */ Queue_Propag_Mask(fdv_adr) |= propag; } } /*-------------------------------------------------------------------------* * PL_FD_AFTER_ADD_CSTR * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_After_Add_Cstr(Bool result_of_tell) { WamWord *fdv_adr; WamWord propag; WamWord *record_adr; WamWord **chain_adr; WamWord *CF; WamWord *BP; PlULong date = DATE; /* local copy for efficiency */ PlULong *pdate; WamWord *AF; PlLong (*fct) (); if (!result_of_tell) { clear_queue: Clear_Queue(); /* Do it now, not in Pl_Fd_Before_Add_Cstr (see comment above) */ return FALSE; } if (TP == dummy_fd_var) return TRUE; BP = Queue_Next_Fdv_Adr(dummy_fd_var); for (;;) { fdv_adr = (WamWord *) BP; propag = Queue_Propag_Mask(fdv_adr); /* NB: the var must stay in the queue until fix-point (no more reactivations) */ /* add a mask to keep it in the queue (in case it is reactivated) */ Queue_Propag_Mask(fdv_adr) = MASK_TO_KEEP_IN_QUEUE; chain_adr = &Chain_Min(fdv_adr); for (; propag; propag >>= 1, chain_adr++) if (propag & 1) { record_adr = (*chain_adr); do { CF = CF_Pointer(record_adr); #if 1 /* optim #2 (and for 'stop constraint' management) */ pdate = Optim_Pointer(CF); if (*pdate != DATE_ALWAYS && *pdate != date) continue; #endif fct = Cstr_Address(CF); AF = AF_Pointer(CF); fct = (PlLong (*)()) (*fct) (AF); if (fct == (PlLong (*)()) FALSE) { failure: Queue_Next_Fdv_Adr(dummy_fd_var) = BP; /* update begin of remaining queue */ goto clear_queue; } #if 1 /* FD switch */ if (fct != (PlLong (*)()) TRUE) /* FD switch case triggered */ { if ((*fct) (AF) == FALSE) goto failure; Pl_Fd_Stop_Constraint(CF); } #endif } while ((record_adr = Next_Chain(record_adr)) != NULL); } /* undo the mask */ Queue_Propag_Mask(fdv_adr) &= (MASK_TO_KEEP_IN_QUEUE - 1); /* reactivated ? */ if (Queue_Propag_Mask(fdv_adr) == 0) /* no longer in queue ? */ { /* Del_Var_From_Queue(fdv_adr); since Queue_Propag_Mask(fdv_adr) == 0 */ if (BP == TP) break; BP = Queue_Next_Fdv_Adr(BP); } } TP = dummy_fd_var; /* queue is now empty */ return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_STOP_CONSTRAINT * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Stop_Constraint(WamWord *CF) { FD_Bind_OV((WamWord *) (CF + OFFSET_OF_OPTIM_POINTER), (WamWord) (&optim2_date_never)); } /*-------------------------------------------------------------------------* * PL_FD_IN_INTERVAL * * * * Used by domain predicates. * *-------------------------------------------------------------------------*/ Bool Pl_Fd_In_Interval(WamWord *fdv_adr, int min, int max) { Pl_Fd_Before_Add_Cstr(); return Pl_Fd_After_Add_Cstr(Pl_Fd_Tell_Interval(fdv_adr, min, max)); } /*-------------------------------------------------------------------------* * PL_FD_IN_RANGE * * * * Used by domain predicates. * *-------------------------------------------------------------------------*/ Bool Pl_Fd_In_Range(WamWord *fdv_adr, Range *range) { Pl_Fd_Before_Add_Cstr(); return Pl_Fd_After_Add_Cstr(Pl_Fd_Tell_Range(fdv_adr, range)); } /*-------------------------------------------------------------------------* * PL_FD_ASSIGN_VALUE_FAST * * * * fdv_adr is an FDV and n belongs to the range of the FD var. * * Like Pl_Fd_Unify_With_Integer0 but specialized Pl_Fd_Tell_Value without * * useless tests (ie. groundness and Pl_Range_Test_Value()) * * Used by labeling predicates. * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Assign_Value_Fast(WamWord *fdv_adr, int n) { int propag; /* Pl_Unify(X,n) == X in n..n */ Pl_Fd_Before_Add_Cstr(); Update_Range_From_Int(fdv_adr, n, propag); All_Propagations(fdv_adr, propag); return Pl_Fd_After_Add_Cstr(TRUE); } /*-------------------------------------------------------------------------* * PL_FD_UNIFY_WITH_INTEGER0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Unify_With_Integer0(WamWord *fdv_adr, int n) { /* Pl_Unify(X,n) == X in n..n */ Pl_Fd_Before_Add_Cstr(); return Pl_Fd_After_Add_Cstr(Pl_Fd_Tell_Value(fdv_adr, n)); } /*-------------------------------------------------------------------------* * PL_FD_REMOVE_VALUE * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Remove_Value(WamWord *fdv_adr, int n) { Pl_Fd_Before_Add_Cstr(); return Pl_Fd_After_Add_Cstr(Pl_Fd_Tell_Not_Value(fdv_adr, n)); } /*-------------------------------------------------------------------------* * PL_FD_UNIFY_WITH_FD_VAR0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Unify_With_Fd_Var0(WamWord *fdv_adr1, WamWord *fdv_adr2) { Bool pl_unify_x_y(WamWord x, WamWord y); /* defined in fd_unify.fd as a constraint */ return pl_unify_x_y(Tag_REF(fdv_adr1), Tag_REF(fdv_adr2)); } /*-------------------------------------------------------------------------* * PL_FD_USE_VECTOR * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Use_Vector(WamWord *fdv_adr) { Range range; if (Is_Sparse(Range(fdv_adr))) return TRUE; Pl_Fd_Before_Add_Cstr(); { WamWord *save_CS = CS; /* code of fd_allocate (from fd_to_c.h) */ CS += pl_vec_size; Range_Init_Interval(&range, 0, INTERVAL_MAX_INTEGER); Pl_Range_Becomes_Sparse(&range); CS = save_CS; /* code of fd_deallocate (from fd_to_c.h) */ } return Pl_Fd_After_Add_Cstr(Pl_Fd_Tell_Range_Range(fdv_adr, &range)); } /*-------------------------------------------------------------------------* * PL_FD_CHECK_FOR_BOOL_VAR * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Check_For_Bool_Var(WamWord x_word) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; Range range; Bool result_of_tell; DEREF(x_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Bool_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); return TRUE; } if (tag_mask == TAG_INT_MASK) return (PlULong) (UnTag_INT(word)) <= 1; if (tag_mask != TAG_FDV_MASK) Pl_Err_Type(pl_type_fd_variable, word); fdv_adr = UnTag_FDV(word); if (Min(fdv_adr) > 1) return FALSE; if (Max(fdv_adr) <= 1) return TRUE; /* here max > 1 */ if (Min(fdv_adr) == 1) return Pl_Fd_Unify_With_Integer0(fdv_adr, 1); /* here min == 0 */ if (!Pl_Range_Test_Value(Range(fdv_adr), 1)) return Pl_Fd_Unify_With_Integer0(fdv_adr, 0); /* Check Bool == X in 0..1 */ Pl_Fd_Before_Add_Cstr(); if (Is_Sparse(Range(fdv_adr))) { Range_Init_Interval(&range, 0, 1); result_of_tell = Pl_Fd_Tell_Range_Range(fdv_adr, &range); } else result_of_tell = Pl_Fd_Tell_Interv_Interv(fdv_adr, 0, 1); return Pl_Fd_After_Add_Cstr(result_of_tell); } /*-------------------------------------------------------------------------* * PL_FD_VARIABLE_SIZE0 * * * *-------------------------------------------------------------------------*/ int Pl_Fd_Variable_Size0(WamWord *fdv_adr) { int size = FD_VARIABLE_FRAME_SIZE; if (Is_Sparse(Range(fdv_adr))) size += pl_vec_size; return size; } /*-------------------------------------------------------------------------* * PL_FD_COPY_VARIABLE0 * * * * returns the size of the created fd var. * *-------------------------------------------------------------------------*/ int Pl_Fd_Copy_Variable0(WamWord *dst_adr, WamWord *fdv_adr) { WamWord *save_CS; int size; save_CS = CS; CS = dst_adr; Pl_Fd_New_Variable(); /* we know that it is pushed at CS (=dst_adr) */ Nb_Elem(dst_adr) = Nb_Elem(fdv_adr); Pl_Range_Copy(Range(dst_adr), Range(fdv_adr)); size = CS - dst_adr; CS = save_CS; return size; } /*-------------------------------------------------------------------------* * PL_FD_VARIABLE_TO_STRING0 * * * *-------------------------------------------------------------------------*/ char * Pl_Fd_Variable_To_String0(WamWord *fdv_adr) { return Pl_Range_To_String(Range(fdv_adr)); } /*-------------------------------------------------------------------------* * PL_FD_DISPLAY_EXTRA_CSTR * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Display_Extra_Cstr(WamWord *fdv_adr) { Pl_Stream_Printf(pl_stm_tbl[pl_stm_stdout], MSG_VECTOR_TOO_SMALL, Cstr_Offset(fdv_adr)); } ����������������������gprolog-1.4.5/src/EngineFD/fd_range.h���������������������������������������������������������������0000644�0001750�0001750�00000020657�13021324543�015455� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : fd_range.h * * Descr.: FD Range Implementation - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "bool.h" #include "pl_long.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef PlULong VecWord; typedef VecWord *Vector; typedef struct /* Ranges are always handled through pointers */ { Bool extra_cstr; int min; int max; Vector vec; } Range; /*---------------------------------* * Global Variables * *---------------------------------*/ #include "fd_hook_range.h" /* Default definitions (if not defined in fd_hook_range.h) */ #ifndef WORD_SIZE # define WORD_SIZE 32 #endif #if WORD_SIZE == 32 # define WORD_SIZE_BITS 5 #else # define WORD_SIZE_BITS 6 #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Define_Vector_Size(int max_val); void Pl_Vector_From_Interval(Vector vec, int min, int max); int Pl_Vector_Nb_Elem(Vector vec); int Pl_Vector_Ith_Elem(Vector vec, int n); int Pl_Vector_Next_After(Vector vec, int n); int Pl_Vector_Next_Before(Vector vec, int n); void Pl_Vector_Empty(Vector vec); void Pl_Vector_Full(Vector vec); Bool Pl_Vector_Test_Null_Inter(Vector vec, Vector vec1); void Pl_Vector_Copy(Vector vec, Vector vec1); void Pl_Vector_Union(Vector vec, Vector vec1); void Pl_Vector_Inter(Vector vec, Vector vec1); void Pl_Vector_Compl(Vector vec); void Pl_Vector_Add_Vector(Vector vec, Vector vec1); void Pl_Vector_Sub_Vector(Vector vec, Vector vec1); void Pl_Vector_Mul_Vector(Vector vec, Vector vec1); void Pl_Vector_Div_Vector(Vector vec, Vector vec1); void Pl_Vector_Mod_Vector(Vector vec, Vector vec1); void Pl_Vector_Add_Value(Vector vec, int n); void Pl_Vector_Mul_Value(Vector vec, int n); void Pl_Vector_Div_Value(Vector vec, int n); void Pl_Vector_Mod_Value(Vector vec, int n); Bool Pl_Range_Test_Value(Range *range, int n); Bool Pl_Range_Test_Null_Inter(Range *range, Range *range1); void Pl_Range_Copy(Range *range, Range *range1); int Pl_Range_Nb_Elem(Range *range); int Pl_Range_Ith_Elem(Range *range, int n); int Pl_Range_Next_After(Range *range, int n); int Pl_Range_Next_Before(Range *range, int n); void Pl_Range_Set_Value(Range *range, int n); void Pl_Range_Reset_Value(Range *range, int n); void Pl_Range_Becomes_Sparse(Range *range); void Pl_Range_From_Vector(Range *range); void Pl_Range_Union(Range *range, Range *range1); void Pl_Range_Inter(Range *range, Range *range1); void Pl_Range_Compl(Range *range); void Pl_Range_Add_Range(Range *range, Range *range1); void Pl_Range_Sub_Range(Range *range, Range *range1); void Pl_Range_Mul_Range(Range *range, Range *range1); void Pl_Range_Div_Range(Range *range, Range *range1); void Pl_Range_Mod_Range(Range *range, Range *range1); void Pl_Range_Add_Value(Range *range, int n); void Pl_Range_Mul_Value(Range *range, int n); void Pl_Range_Div_Value(Range *range, int n); void Pl_Range_Mod_Value(Range *range, int n); char *Pl_Range_To_String(Range *range); /*---------------------------------* * Vector Management Macros * *---------------------------------*/ #define Word_No_And_Bit_No(w, b) (((VecWord) (w) << WORD_SIZE_BITS)|\ (VecWord) (b)) #define Word_No(n) ((VecWord) (n) >> WORD_SIZE_BITS) #define Bit_No(n) ((n) & (((VecWord) 1 << WORD_SIZE_BITS)-1)) #define Vector_Test_Value(vec, n) ((vec[Word_No(n)] & ((VecWord) 1 << Bit_No(n))) != 0) #define Vector_Set_Value(vec, n) (vec[Word_No(n)] |= ((VecWord) 1 << Bit_No(n))) #define Vector_Reset_Value(vec, n) (vec[Word_No(n)] &= ~((VecWord) 1 << Bit_No(n))) #define Vector_Allocate_If_Necessary(vec) \ do \ { \ if (vec == NULL) \ Vector_Allocate(vec); \ } \ while (0) #define Vector_Allocate(vec) \ do \ { \ vec = (Vector) RANGE_TOP_STACK; \ RANGE_TOP_STACK += pl_vec_size; \ } \ while (0) /* To enumerate a vector use VECTOR_BEGIN_ENUM / VECTOR_END_ENUM * * macros as follows: * * ... * * VECTOR_BEGIN_ENUM(the_vector,vec_elem) * * your code (vec_elem contains the current range element) * * VECTOR_END_ENUM */ #define VECTOR_BEGIN_ENUM(vec, vec_elem) \ { \ Vector enum_end = vec + pl_vec_size, enum_i = vec; \ int enum_j; \ VecWord enum_word; \ \ vec_elem = 0; \ do \ { \ enum_word = *enum_i; \ for (enum_j = 0; enum_j++ < WORD_SIZE; enum_word >>= 1, vec_elem++) \ { \ if (enum_word & 1) \ { #define VECTOR_END_ENUM \ } \ } \ } \ while (++enum_i < enum_end); \ } /*---------------------------------* * Range Management Macros * *---------------------------------*/ #define Is_Interval(range) ((range)->vec == NULL) #define Is_Sparse(range) ((range)->vec != NULL) #define Is_Empty(range) ((range)->min > (range)->max) #define Is_Not_Empty(range) ((range)->max >= (range)->min) #define Set_To_Empty(range) (range)->max = (int)(1 << (sizeof(int) * 8 - 1)) #define Range_Init_Interval(range, r_min, r_max) \ do \ { \ (range)->extra_cstr = FALSE; \ (range)->min = (r_min); \ (range)->max = (r_max); \ (range)->vec = NULL; \ } \ while (0) ���������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/fd_to_c.h����������������������������������������������������������������0000644�0001750�0001750�00000033166�13021324543�015304� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver * * File : fd_to_c.h * * Descr.: FD to C macros - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _FD_TO_C_H #define _FD_TO_C_H #include <stdio.h> #include "../EnginePl/pl_params.h" #include "../EnginePl/wam_archi.h" #include "engine_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /* Environment Frame */ #define Frame_Variable(fv) ((WamWord *)(AF[fv])) #define Frame_Range_Parameter(fp) ((Range *) (AF[fp])) #define Frame_Term_Parameter(fp) ((int) (AF[fp])) #define Frame_List_Parameter(fp) ((WamWord *)(AF[fp])) #define chain_min CHAIN_NB_MIN #define chain_max CHAIN_NB_MAX #define chain_min_max CHAIN_NB_MIN_MAX #define chain_dom CHAIN_NB_DOM #define chain_val CHAIN_NB_VAL /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*---------------------------------* * Auxiliary engine macros * *---------------------------------*/ #define DivDn(x, y) ((x) / (y)) #define DivUp(x, y) (((x) + (y) - 1) / (y)) #define R(r_no) rr##r_no /* Interface with Prolog clauses instructions */ #define fd_create_a_frame(nb_arg) \ AF = CS; \ CS += nb_arg; #define fd_int_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Value(fd_##arg); #define fd_range_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Range(fd_##arg); #define fd_fdv_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Fd_Var(fd_##arg, TRUE); #define fd_fdv_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Fd_Var(fd_##arg, TRUE); #define fd_any_in_a_frame(arg, offset) \ AF[offset] = (WamWord) fd_##arg; #define fd_l_int_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Array_Int(fd_##arg); #define fd_l_range_in_a_frame(arg, offset) \ printf("fd_l_range_in_a_frame not yet implemented...\n"); #define fd_l_fdv_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Array_Fdv(fd_##arg, TRUE); #define fd_l_any_in_a_frame(arg, offset) \ AF[offset] = (WamWord) Pl_Fd_Prolog_To_Array_Any(fd_##arg); #define fd_cf_in_a_frame(offset) \ AF[offset] = (WamWord) CF; #define fd_call_internal(fct_name) \ if (!fct_name(AF)) \ { \ ret_val = FALSE; \ goto lab_exit; \ } #define fd_call_internal_and_test_switch_simple(fct_name) \ { \ PlLong (*fct) () = (PlLong (*)()) fct_name(AF); \ \ if (fct == (PlLong (*)()) FALSE) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ if (fct != (PlLong (*)()) TRUE)/* FD switch case triggered */ \ { \ if ((*fct) (AF) == FALSE) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ } \ } #define fd_call_internal_and_test_switch(fct_name) \ { \ PlLong (*fct) () = (PlLong (*)()) fct_name(AF); \ \ if (fct == (PlLong (*)()) FALSE) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ if (fct != (PlLong (*)()) TRUE)/* FD switch case triggered */ \ { \ if ((*fct) (AF) == FALSE) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ \ Pl_Fd_Stop_Constraint(CF); \ } \ } #define fd_stop_constraint(offset) \ if (AF[offset]) \ Pl_Fd_Stop_Constraint((WamWord *) (AF[offset])); /* Install instructions */ #define fd_create_c_frame(fct_name, tell_fv, optim2) \ CF = Pl_Fd_Create_C_Frame(fct_name, AF, \ (tell_fv == -1) ? NULL : Frame_Variable(tell_fv), \ optim2); #define fd_add_dependency(fv, ch) \ Pl_Fd_Add_Dependency(Frame_Variable(fv), chain_##ch, CF); #define fd_add_list_dependency(fv, ch) \ Pl_Fd_Add_List_Dependency(Frame_Variable(fv), chain_##ch, CF); /* Constraint instructions */ #define fd_before_add_constraint \ Pl_Fd_Before_Add_Cstr(); #define fd_after_add_constraint \ ret_val = Pl_Fd_After_Add_Cstr(ret_val); /* always followed by fd_return */ #define fd_allocate \ { \ WamWord *save_CS = CS; \ CS += pl_vec_size; #define fd_deallocate \ CS = save_CS; \ } #define fd_tell_value(fv, t) \ { \ fdv_adr = Frame_Variable(fv); \ if (!Pl_Fd_Tell_Value(fdv_adr, t)) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ } #define fd_tell_not_value(fv, t) \ { \ fdv_adr = Frame_Variable(fv); \ if (!Pl_Fd_Tell_Not_Value(fdv_adr, t)) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ } #define fd_tell_interval(fv, t_min, t_max) \ { \ fdv_adr = Frame_Variable(fv); \ if (!Pl_Fd_Tell_Interval(fdv_adr, t_min, t_max)) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ } #define fd_tell_range(fv, r) \ { \ fdv_adr = Frame_Variable(fv); \ if (!Pl_Fd_Tell_Range(fdv_adr, &R(r))) \ { \ ret_val = FALSE; \ goto lab_exit; \ } \ } #define fd_check_fct(fct) \ if (!fct) \ { \ ret_val = FALSE; \ goto lab_exit; \ } /* Tests */ #define fd_test_exit_condition(t) \ if (t) \ goto lab_exit; #define fd_test_fail_condition(t) \ if (!t) \ { \ ret_val = FALSE; \ goto lab_exit; \ } #define fd_test_switch_condition(t, fct_name) \ if (t) \ { \ ret_val = (PlLong) fct_name; \ goto lab_exit; \ } /* Range */ #define fd_range_interval(r, t_min, t_max) \ Range_Init_Interval(&R(r), t_min, t_max); #define fd_load_range(r, fp) \ R(r).vec = NULL; \ Pl_Range_Copy(&R(r), Frame_Range_Parameter(fp)); #define fd_load_dom(r, fv) \ fdv_adr = Frame_Variable(fv); \ R(r).vec = NULL; \ Pl_Range_Copy(&R(r), Range(fdv_adr)); #define fd_range_union(r, r1) \ Pl_Range_Union(&R(r), &R(r1)); #define fd_range_inter(r, r1) \ Pl_Range_Inter(&R(r), &R(r1)); #define fd_range_compl(r) \ Pl_Range_Compl(&R(r)); #define fd_range_empty(r) \ R(r).vec = NULL; \ Set_To_Empty(&R(r)); #define fd_range_full(r) \ Range_Init_Interval(&R(r), 0, INTERVAL_MAX_INTEGER); #define fd_range_set_value(r, t) \ Pl_Range_Set_Value(&R(r), t); #define fd_range_reset_value(r, t) \ Pl_Range_Reset_Value(&R(r), t); #define fd_range_add_range(r, r1) \ Pl_Range_Add_Range(&R(r), &R(r1)); #define fd_range_sub_range(r, r1) \ Pl_Range_Sub_Range(&R(r), &R(r1)); #define fd_range_mul_range(r, r1) \ Pl_Range_Mul_Range(&R(r), &R(r1)); #define fd_range_div_range(r, r1) \ Pl_Range_Div_Range(&R(r), &R(r1)); #define fd_range_mod_range(r, r1) \ Pl_Range_Mod_Range(&R(r), &R(r1)); #define fd_range_add_value(r, t) \ Pl_Range_Add_Value(&R(r), t); #define fd_range_sub_value(r, t) \ Pl_Range_Add_Value(&R(r), -(t)); #define fd_range_mul_value(r, t) \ Pl_Range_Mul_Value(&R(r), t); #define fd_range_div_value(r, t) \ Pl_Range_Div_Value(&R(r), t); #define fd_range_mod_value(r, t) \ Pl_Range_Mod_Value(&R(r), t); #define fd_range_copy(r, r1) \ R(r).vec = NULL; \ Pl_Range_Copy(&R(r), &R(r1)); #define fd_range_fct(fct_name, r, args) \ { \ void fct_name(); \ R(r).vec = NULL; \ fct_name(&R(r), args); \ } /* term */ #define fd_load_int(var_name, fp) \ var_name = Frame_Term_Parameter(fp); #define fd_load_min(var_name, fv) \ fdv_adr = Frame_Variable(fv); \ var_name = Min(fdv_adr); #define fd_load_max(var_name, fv) \ fdv_adr = Frame_Variable(fv); \ var_name = Max(fdv_adr); #define fd_load_min_max(var_name_min, var_name_max, fv) \ fdv_adr = Frame_Variable(fv); \ var_name_min = Min(fdv_adr); \ var_name_max = Max(fdv_adr); #define fd_load_val(var_name, fv) \ fdv_adr = Frame_Variable(fv); \ if (Fd_Variable_Is_Ground(fdv_adr)) \ var_name = Min(fdv_adr); \ else \ goto lab_exit; #define fd_min_of_range(var_name, r) \ var_name = R(r).min; #define fd_max_of_range(var_name, r) \ var_name = R(r).max; #define fd_value_copy(t, t1) \ (t) = (t1); #define fd_load_l_int(var_name, fp) \ var_name = Frame_List_Parameter(fp); #define fd_load_l_fdv(var_name, fp) \ var_name = Frame_List_Parameter(fp); #define fd_load_l_any(var_name, fp) \ var_name = Frame_List_Parameter(fp); #define arg_1(a1) a1 #define arg_2(a1, a2) a1, a2 #define arg_3(a1, a2, a3) a1, a2, a3 #define arg_4(a1, a2, a3, a4) a1, a2, a3, a4 #define arg_5(a1, a2, a3, a4, a5) a1, a2, a3, a4, a5 #define arg_6(a1, a2, a3, a4, a5, a6) a1, a2, a3, a4, a5, a6 #define arg_7(a1, a2, a3, a4, a5, a6, a7) a1, a2, a3, a4, a5, a6, a7 #define arg_8(a1, a2, a3, a4, a5, a6, a7, a8) a1, a2, a3, a4, a5, a6, a7, a8 #define arg_9(a1, a2, a3, a4, a5, a6, a7, a8, a9) a1, a2, a3, a4, a5, a6, a7, a8, a9 #define range_arg(r) &R(r) /* by address */ /*---------------------------------* * Interface with C files * *---------------------------------*/ #define max_integer INTERVAL_MAX_INTEGER #define FdArg(arg) WamWord fd_##arg #define fd_begin_user_constraint(name_args) \ Bool \ name_args \ { \ WamWord *AF; \ PlLong ret_val = TRUE; #define fd_end_user_constraint \ } #define fd_begin_internal(fct_name) \ static PlLong \ fct_name(WamWord *AF) \ { \ PlLong ret_val = TRUE; #define fd_end_internal \ } #define fd_exit_point \ lab_exit: #define fd_return \ return ret_val; #define fd_local_value_var(var_name) \ int var_name; #define fd_local_range_var(r) \ Range R(r); /* = {FALSE, 0, 0, NULL} init should be useless */ #define fd_local_l_int_var(var_name) \ WamWord *var_name; #define fd_local_l_fdv_var(var_name) \ WamWord *var_name; #define fd_local_l_any_var(var_name) \ WamWord *var_name; #define fd_local_cf_pointer \ WamWord *CF; #ifdef __GNUC__ #define fd_local_fdv_adr \ WamWord *fdv_adr __attribute__((unused)); #else #define fd_local_fdv_adr \ WamWord *fdv_adr; #endif #define fd_init_local_value_var(var_name, term) \ var_name = (term); #define fd_forall(fv, l_fv) \ { \ int n = *l_fv++; \ while (n--) \ { \ AF[fv] = *l_fv++; #define fd_forall_end \ } \ } #endif /* !_FD_TO_C_H */ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/EngineFD/Makefile.in��������������������������������������������������������������0000644�0001750�0001750�00000001423�13021324543�015572� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������LIB_ENGINE_FD = @LIB_ENGINE_FD@ GPLC = @GPLC@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ AR_RC = @AR_RC@ RANLIB = @RANLIB@ LIBNAME = $(LIB_ENGINE_FD) OBJLIB = fd_inst@OBJ_SUFFIX@ fd_range@OBJ_SUFFIX@ fd_unify@OBJ_SUFFIX@ .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .c .fd $(SUFFIXES) $(LIBNAME): $(OBJLIB) rm -f $(LIBNAME) $(AR_RC)@AR_SEP@$(LIBNAME) $(OBJLIB) $(RANLIB) $(LIBNAME) .fd@OBJ_SUFFIX@: $(GPLC) -c -C '$(CFLAGS)' $*.fd .c@OBJ_SUFFIX@: $(GPLC) -c -C '$(CFLAGS)' $*.c fd_inst@OBJ_SUFFIX@: fd_inst.h fd_inst.c fd_range.h fd_hook_range.h fd_range@OBJ_SUFFIX@: fd_range.h fd_hook_range.h fd_range.c fd_unify@OBJ_SUFFIX@: fd_unify.fd clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp $(LIBNAME) distclean: clean ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/configure.in����������������������������������������������������������������������0000644�0001750�0001750�00000070034�13021324543�014423� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������dnl ********************************* dnl * autoconf configuration script * dnl ********************************* AC_INIT(gprolog, 1.4.5, bug-prolog@gnu.org,,www.gprolog.org) AC_PREREQ(2.52) dnl AC_CONFIG_AUX_DIR(ConfUtils) to do... AC_CONFIG_SRCDIR(SETVARS) dnl *************************** dnl * initial variable values * dnl *************************** pl_date() { LC_ALL=C date '+%b %e %Y' } PROLOG_NAME='GNU Prolog' PROLOG_DIALECT='gprolog' PROLOG_VERSION=$PACKAGE_VERSION PROLOG_DATE=`pl_date` PROLOG_COPYRIGHT='Copyright (C) 1999-2015 Daniel Diaz' TOP_LEVEL=$PROLOG_DIALECT GPLC=gplc HEXGPLC=hexgplc ENV_VARIABLE=PL_PATH USE_EBP=no USE_LINEDIT=yes USE_GUI_CONSOLE=yes WITH_HTMLHELP=static USE_SOCKETS=yes USE_FD_SOLVER=yes DLL_W32GUICONS=w32guicons LIB_LINEDIT=liblinedit LIB_ENGINE_PL=libengine_pl LIB_BIPS_PL=libbips_pl LIB_ENGINE_FD=libengine_fd LIB_BIPS_FD=libbips_fd dnl ****************** dnl * variable names * dnl ****************** AC_SUBST(PROLOG_DIALECT) AC_SUBST(PROLOG_NAME) AC_SUBST(PROLOG_VERSION) AC_SUBST(PROLOG_DATE) AC_SUBST(PROLOG_COPYRIGHT) AC_SUBST(TOP_LEVEL) AC_SUBST(GPLC) AC_SUBST(HEXGPLC) AC_SUBST(ENV_VARIABLE) AC_SUBST(TOP_LEVEL_FLAGS) AC_SUBST(CFLAGS_PREFIX_REG) AC_SUBST(CFLAGS_MACHINE) AC_SUBST(CFLAGS_UNSIGNED_CHAR) AC_SUBST(LDLIBS) AC_SUBST(LDGUILIBS) AC_SUBST(ASM_SUFFIX) AC_SUBST(OBJ_SUFFIX) AC_SUBST(EXE_SUFFIX) AC_SUBST(CC_OBJ_NAME_OPT) AC_SUBST(CC_EXE_NAME_OPT) AC_SUBST(AR_RC) AC_SUBST(AR_SEP) AC_SUBST(AS) AC_SUBST(ASFLAGS) AC_SUBST(STRIP) AC_SUBST(RC) AC_SUBST(RCFLAGS) AC_SUBST(RC_OUT_NAME_OPT) AC_SUBST(LD) AC_SUBST(LD_OUT_NAME_OPT) AC_SUBST(LD_DLL_OPT) AC_SUBST(ROOT_DIR) AC_SUBST(ROOT_DIR1) AC_SUBST(PKG_NAME) AC_SUBST(INSTALL_DIR) AC_SUBST(LINKS_DIR) AC_SUBST(DOC_DIR) AC_SUBST(HTML_DIR) AC_SUBST(EXAMPLES_DIR) AC_SUBST(WITH_MSVC) AC_SUBST(WIN_TMP_DIR) AC_SUBST(WIN_CONF_OPT) AC_SUBST(WIN_CC_VER) AC_SUBST(TXT_FILES) AC_SUBST(BIN_FILES) AC_SUBST(OBJ_FILES) AC_SUBST(LIB_FILES) AC_SUBST(INC_FILES) AC_SUBST(DOC_FILES) AC_SUBST(HTML_FILES) AC_SUBST(EXPL_FILES) AC_SUBST(EXC_FILES) AC_SUBST(EXFD_FILES) AC_SUBST(MAKE_LE_DIRS) AC_SUBST(MAKE_W32GC_DIRS) AC_SUBST(MAKE_FD_DIRS) AC_SUBST(MAKE_ENGINE1_SRC) AC_SUBST(MAKE_LE_INTERF_OBJS) AC_SUBST(MAKE_SOCKETS_OBJS) AC_SUBST(DLL_W32GUICONS) AC_SUBST(LIB_LINEDIT) AC_SUBST(LIB_ENGINE_PL) AC_SUBST(LIB_BIPS_PL) AC_SUBST(LIB_ENGINE_FD) AC_SUBST(LIB_BIPS_FD) dnl ******************* dnl * package options * dnl ******************* AC_ARG_WITH(install-dir, [ --with-install-dir=DIR specify INSTALL_DIR], [WITH_INSTALL_DIR="$withval"]) AC_ARG_WITH(links-dir, [ --with-links-dir=DIR specify LINKS_DIR], [WITH_LINKS_DIR="$withval"]) AC_ARG_WITH(doc-dir, [ --with-doc-dir=DIR specify DOC_DIR], [WITH_DOC_DIR="$withval"]) AC_ARG_WITH(html-dir, [ --with-html-dir=DIR specify HTML_DIR], [WITH_HTML_DIR="$withval"]) AC_ARG_WITH(examples-dir,[ --with-examples-dir=DIR specify EXAMPLES_DIR], [WITH_EXAMPLES_DIR="$withval"]) AC_ARG_WITH(msvc, [ --with-msvc use MS VC++], [WITH_MSVC="$withval"], [WITH_MSVC=no]) AC_ARG_WITH(c-flags, [[ --with-c-flags[=FLAGS] specify C flags]], [WITH_C_FLAGS="$withval"], [WITH_C_FLAGS=yes]) AC_ARG_ENABLE(regs, [ --disable-regs do not use machine registers], [case "$enableval" in no) AC_DEFINE(NO_USE_REGS);; *) ;; esac]) AC_ARG_ENABLE(ebp, [ --enable-ebp use the ebp register on ix86 machines], [case "$enableval" in yes) USE_EBP=yes;; *) ;; esac]) AC_ARG_ENABLE(fast-call, [ --disable-fast-call do not use fast call on ix86], [case "$enableval" in no) AC_DEFINE(NO_USE_FAST_CALL);; *) ;; esac]) AC_ARG_ENABLE(linedit, [ --disable-linedit do not include line editor facility], [case "$enableval" in no) AC_DEFINE(NO_USE_LINEDIT) USE_LINEDIT=no;; *) ;; esac]) AC_ARG_ENABLE(piped-consult, [ --disable-piped-consult do not pipe stdin of pl2wam when consult/1], [case "$enableval" in no) AC_DEFINE(NO_USE_PIPED_STDIN_FOR_CONSULT);; *) ;; esac]) AC_ARG_ENABLE(gui-console,[ --disable-gui-console do not use the Windows GUI console], [case "$enableval" in no) AC_DEFINE(NO_USE_GUI_CONSOLE) USE_GUI_CONSOLE=no;; *) USE_GUI_CONSOLE=yes;; esac]) AC_ARG_ENABLE(htmlhelp,[ --disable-htmlhelp do not use Windows HtmlHelp inside the GUI console], [WITH_HTMLHELP="$enableval"]) AC_ARG_ENABLE(sockets, [ --disable-sockets do not include sockets facility], [case "$enableval" in no) AC_DEFINE(NO_USE_SOCKETS) USE_SOCKETS=no;; *) ;; esac]) AC_ARG_ENABLE(fd-solver, [ --disable-fd-solver do not include the FD constraint solver], [case "$enableval" in no) AC_DEFINE(NO_USE_FD_SOLVER) USE_FD_SOLVER=no;; *) ;; esac]) if test "$USE_EBP" = no; then AC_DEFINE(NO_USE_EBP) fi dnl *********************** dnl * checks for programs * dnl *********************** if test "$host_alias" != ''; then WIN_CONF_OPT="$WIN_CONF_OPT --host=$host_alias" fi if test "$build_alias" != ''; then WIN_CONF_OPT="$WIN_CONF_OPT --build=$build_alias" fi if test "$WITH_MSVC" != no; then echo "using MSVC++ as C compiler" CC=cl WIN_CONF_OPT="$WIN_CONF_OPT --with-msvc" fi dnl should be always done to correctly set EXEEXT (CC is set to cl for MSVC) dnl cannot be put in the then and the else part !!! so repeat the test ! AC_PROG_CC AC_CANONICAL_HOST AC_CANONICAL_BUILD dnl determine if MinGW and Windows path associated to posix path /tmp dnl (needs AC_CANONICAL_BUILD) case "$build_os" in cygwin*) WIN_TMP_DIR=`cygpath -d -a /tmp`; CYGWIN=yes;; mingw*) WIN_TMP_DIR=`cd /tmp;pwd -W|sed -e 's:/:\\\:g'`;; esac dnl determine if use MinGW dnl (needs AC_CANONICAL_HOST) case "$host_os" in mingw*) MINGW=yes; WIN_CC_VER=mingw;; esac dnl customize MSVC MAKE_ENGINE1_SRC='engine1.c' if test "$WITH_MSVC" != no; then dnl NB: double [[ ]] for m4 dnl WIN_CC_VER=msvc-`cl 2>&1 | tr '\377' ' ' | sed -ne 's/.*ersion *\([[0-9]]\{1,3\}\.[[0-9]]\{1,3\}\).*/\1/p'` WIN_CC_VER=msvc dnl test if cl.exe runs in 32 or 64 bits (return 0 if in 64 bits) AC_MSG_CHECKING(for cl.exe producing 32-bit or 64-bit executables) AC_RUN_IFELSE([AC_LANG_SOURCE([[int main() { return sizeof(void *) != 8; }]])], [ AC_MSG_RESULT(64-bit mode (x86_64)) cl_mode=64], [ AC_MSG_RESULT(32-bit mode (x86)) cl_mode=32], [ AC_MSG_RESULT([can't test in cross-compiling])]) if test $cl_mode = 32; then WITH_MSVC=32 host_cpu=i686 host_os=win32 AS=mingw-as ASFLAGS='--32' else WITH_MSVC=64 host_cpu=x86_64 host_os=win64 AS=yasm-win64 ASFLAGS='-f win64 -p gas' MAKE_ENGINE1_SRC='eng1-x86_64_win.s' fi host_vendor=microsoft host=$host_cpu-$host_vendor-$host_os AC_MSG_CHECKING(for actual host system type...) AC_MSG_RESULT($host) ASM_SUFFIX='.s' OBJ_SUFFIX='.obj' LIB_SUFFIX='.lib' CC_OBJ_NAME_OPT='-Fo' CC_EXE_NAME_OPT='-Fe' AC_CHECK_PROGS(WIN_AS_FOUND, $AS,no) if test "$WIN_AS_FOUND" = no; then AC_MSG_ERROR([$AS.exe is required with MSVC++ - A version can be found at gprolog.univ-paris1.fr/$AS.exe]) fi AR_RC='lib -nologo -out:' AR_SEP='' STRIP=: RANLIB=: RC=rc RCFLAGS='' RC_OUT_NAME_OPT='-fo' dnl uset this directly invokes MS link.exe (instead of using cl.exe) dnl LD=link dnl LD_OUT_NAME_OPT='-out:' dnl LD_DLL_OPT='-dll' dnl invokes cl.exe LD=$CC LD_OUT_NAME_OPT='-Fe' LD_DLL_OPT='-link -dll' else if test "$GCC" != yes; then AC_MSG_ERROR([gcc is required (or MSVC++ under Windows)]) fi dnl we use AS0 instead of AS else AC_CHECK_TOOL does not work dnl (instead of testing a prefix like x86_64-w64-mingw32- it will dnl think the user wants to override the test) AS0=as case "$host" in sparc64*bsd*) ASFLAGS='-Av9a -64 -K PIC';; i*86*darwin1*) ASFLAGS='-arch i686';; i*86*linux*) ASFLAGS='--32';; x86_64*solaris*) AS0=gas; ASFLAGS='--64';; x86_64*darwin*) ASFLAGS='-arch x86_64';; x86_64*linux*) ASFLAGS='--64';; *) if test "$with_gas" = yes; then AS0=gas; fi;; esac AC_CHECK_TOOL([AS],[$AS0]) AC_PROG_RANLIB ASM_SUFFIX='.s' OBJ_SUFFIX='.o' LIB_SUFFIX='.a' CC_OBJ_NAME_OPT='-o ' CC_EXE_NAME_OPT='-o ' AC_CHECK_TOOL([RC],[windres]) RCFLAGS='-O coff' RC_OUT_NAME_OPT='-o ' LD=$CC LD_OUT_NAME_OPT='-o ' LD_DLL_OPT='-shared' AC_CHECK_TOOL([AR],[ar]) AR_RC="$AR rc " AR_SEP=' ' AC_CHECK_TOOL([STRIP],[strip]) fi dnl RCFLAGS="$RCFLAGS -l 0x409" EXE_SUFFIX=$EXEEXT AC_PROG_MAKE_SET AC_PROG_INSTALL AC_PROG_LN_S DLL_W32GUICONS=$DLL_W32GUICONS.dll LIB_LINEDIT=$LIB_LINEDIT$LIB_SUFFIX LIB_ENGINE_PL=$LIB_ENGINE_PL$LIB_SUFFIX LIB_BIPS_PL=$LIB_BIPS_PL$LIB_SUFFIX LIB_ENGINE_FD=$LIB_ENGINE_FD$LIB_SUFFIX LIB_BIPS_FD=$LIB_BIPS_FD$LIB_SUFFIX dnl ******************************* dnl * host detection and features * dnl ******************************* WINDOWS=no case "$host" in mips*irix*) AC_DEFINE(M_mips) AC_DEFINE(M_irix) AC_DEFINE(M_mips_irix);; sparc64*bsd*) AC_DEFINE(M_sparc64) AC_DEFINE(M_bsd) AC_DEFINE(M_sparc64_bsd);; sparc*sunos*) AC_DEFINE(M_sparc) AC_DEFINE(M_sunos) AC_DEFINE(M_sparc_sunos);; sparc*solaris*) AC_DEFINE(M_sparc) AC_DEFINE(M_solaris) AC_DEFINE(M_sparc_solaris);; sparc*bsd*) AC_DEFINE(M_sparc) AC_DEFINE(M_bsd) AC_DEFINE(M_sparc_bsd);; alpha*osf*) AC_DEFINE(M_alpha) AC_DEFINE(M_osf) AC_DEFINE(M_alpha_osf);; alpha*linux*) AC_DEFINE(M_alpha) AC_DEFINE(M_linux) AC_DEFINE(M_alpha_linux);; x86_64*linux*) AC_DEFINE(M_x86_64) AC_DEFINE(M_linux) AC_DEFINE(M_x86_64_linux);; x86_64*dragonfly*) AC_DEFINE(M_x86_64) AC_DEFINE(M_bsd) AC_DEFINE(M_x86_64_bsd);; x86_64*bsd*) AC_DEFINE(M_x86_64) AC_DEFINE(M_bsd) AC_DEFINE(M_x86_64_bsd);; x86_64*solaris*) AC_DEFINE(M_x86_64) AC_DEFINE(M_solaris) AC_DEFINE(M_x86_64_solaris);; x86_64*mingw*) AC_DEFINE(M_x86_64) AC_DEFINE(M_win64) AC_DEFINE(M_x86_64_win64) WINDOWS=64;; x86_64*win64*) AC_DEFINE(M_x86_64) AC_DEFINE(M_win64) AC_DEFINE(M_x86_64_win64) WINDOWS=64;; x86_64*darwin*) AC_DEFINE(M_x86_64) AC_DEFINE(M_darwin) AC_DEFINE(M_x86_64_darwin);; i*86*linux*) AC_DEFINE(M_ix86) AC_DEFINE(M_linux) AC_DEFINE(M_ix86_linux);; i*86*solaris*) AC_DEFINE(M_ix86) AC_DEFINE(M_solaris) AC_DEFINE(M_ix86_solaris);; i*86*sco*) AC_DEFINE(M_ix86) AC_DEFINE(M_sco) AC_DEFINE(M_ix86_sco);; i*86*dragonfly*) AC_DEFINE(M_ix86) AC_DEFINE(M_bsd) AC_DEFINE(M_ix86_bsd);; i*86*bsd*) AC_DEFINE(M_ix86) AC_DEFINE(M_bsd) AC_DEFINE(M_ix86_bsd);; i*86*cygwin*) AC_DEFINE(M_ix86) AC_DEFINE(M_cygwin) AC_DEFINE(M_ix86_cygwin);; i*86*mingw*) AC_DEFINE(M_ix86) AC_DEFINE(M_win32) AC_DEFINE(M_ix86_win32) WINDOWS=32;; i*86*win32*) AC_DEFINE(M_ix86) AC_DEFINE(M_win32) AC_DEFINE(M_ix86_win32) WINDOWS=32;; i*86*darwin*) AC_DEFINE(M_ix86) AC_DEFINE(M_darwin) AC_DEFINE(M_ix86_darwin);; powerpc*linux*) AC_DEFINE(M_powerpc) AC_DEFINE(M_linux) AC_DEFINE(M_powerpc_linux);; powerpc*darwin*) AC_DEFINE(M_powerpc) AC_DEFINE(M_darwin) AC_DEFINE(M_powerpc_darwin);; powerpc*bsd*) AC_DEFINE(M_powerpc) AC_DEFINE(M_bsd) AC_DEFINE(M_powerpc_bsd);; *) AC_MSG_ERROR(unsupported architecture) esac dnl M_win64 ==> M_win32 if test "$WINDOWS" = 64; then AC_DEFINE(M_win32) fi case "$WINDOWS" in 32) WIN_CC_VER="$WIN_CC_VER-x86";; 64) WIN_CC_VER="$WIN_CC_VER-x64";; esac dnl ******************** dnl * C compiler flags * dnl ******************** AC_C_BIGENDIAN CFLAGS_MACHINE= CFLAGS_PREFIX_REG= AC_C_INLINE if test "$WITH_MSVC" != no; then case "$WITH_C_FLAGS" in debug) CFLAGS='-W3 -Zi -EHsc';; no) CFLAGS='';; yes) CFLAGS='-O2 -EHsc';; *) CFLAGS="$WITH_C_FLAGS";; esac CFLAGS_UNSIGNED_CHAR='-J' CFLAGS_MACHINE='-nologo -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE' else case "$WITH_C_FLAGS" in debug) CFLAGS='-g -Wall';; no) CFLAGS='';; yes) CFLAGS='-O3 -fomit-frame-pointer';; *) CFLAGS="$WITH_C_FLAGS";; esac dnl -fomit-frame-pointer does not work on MinGW (tested with gcc 3.3.3) if test "$MINGW-$WITH_C_FLAGS" = yes-yes; then CFLAGS='-O3' fi CFLAGS_PREFIX_REG='-ffixed-%s' CFLAGS_UNSIGNED_CHAR='-funsigned-char' CFLAGS_MACHINE= case "$host" in i*86*darwin1*) CFLAGS_MACHINE='-march=i686 -m32';; mips*irix*) CFLAGS_MACHINE='-march=4000';; sparc64*) CFLAGS_MACHINE='';; sparc*sunos4.1.3) CFLAGS_MACHINE='-msupersparc';; sparc*solaris) CFLAGS_MACHINE='-msupersparc';; i686*) CFLAGS_MACHINE='-march=pentiumpro -m32';; i586*) CFLAGS_MACHINE='-march=pentium -m32';; i*86*) CFLAGS_MACHINE='-march=i486 -m32';; powerpc*darwin*) CFLAGS_MACHINE='-mpowerpc -no-cpp-precomp';; x86_64*solaris*) CFLAGS_MACHINE='-m64';; x86_64*darwin*) CFLAGS_MACHINE='-march=x86-64 -m64';; esac case "$host" in i*86*) if test "$USE_EBP" != no; then CF1=`echo $CFLAGS | sed -e 's/\(.*\)-fomit-frame-pointer\(.*\)/\1\2/'` if test "$CF1" != "$CFLAGS"; then echo use ebp and move -fomit-frame-pointer to CFLAGS_MACHINE CFLAGS=$CF1 CFLAGS_MACHINE="$CFLAGS_MACHINE -fomit-frame-pointer" else echo do not use ebp since -fomit-frame-pointer is not specified in CFLAGS USE_EBP=no AC_DEFINE(NO_USE_EBP) fi fi;; esac dnl case "$host" in dnl i*86*) CFLAGS_MACHINE="$CFLAGS_MACHINE -malign-loops=2 -malign-jumps=2 -malign-functions=2";; dnl esac if test "$GCC" = yes; then CFLAGS_MACHINE="$CFLAGS_MACHINE -fno-strict-aliasing" fi dnl For MacOsX - try to avoid this (activate only for fast library fix) dnl case "$host" in dnl powerpc*darwin*) RANLIB="$RANLIB -c";; dnl esac fi SAVE_CFLAGS=$CFLAGS CFLAGS="$CFLAGS_MACHINE $CFLAGS" AC_CHECK_SIZEOF(long) AC_CHECK_SIZEOF(void*) AC_CHECK_HEADERS(sys/ioctl_compat.h sys/siginfo.h termios.h malloc.h endian.h sys/endian.h byteswap.h float.h) AC_FUNC_MMAP dnl use one day AC_CHECK_DECL instead of AC_CHECK_FUNC ? but add the include dnl AC_CHECK_DECLS([getpagesize, mprotect, sigaction, mallopt, fgetc, htole32, bswap_32]) AC_CHECK_FUNCS(getpagesize mprotect sigaction mallopt fgetc) dnl NB: OpenBSD/spac64 needs stdin.h before sys/endian.h AC_CHECK_DECLS([htole32, bswap_32], [], [], [#ifdef HAVE_STDINT_H #include <stdint.h> #endif #include <sys/types.h> #ifdef HAVE_ENDIAN_H #include <endian.h> #endif #ifdef HAVE_SYS_ENDIAN_H #include <sys/endian.h> #endif #ifdef HAVE_BYTESWAP_H #include <byteswap.h> #endif ]) SAVE_LIBS="$LIBS" LIBS="$LIBS -lm" AC_CHECK_FUNCS(atanh acosh asinh) SAVE_LIBS="$LIBS" dnl alternative solution dnl AC_SEARCH_LIBS(asinh, m, AC_DEFINE_UNQUOTED(HAVE_ASINH, 1, [If we have asinh()])) dnl AC_SEARCH_LIBS(acosh, m, AC_DEFINE_UNQUOTED(HAVE_ACOSH, 1, [If we have acosh()])) dnl AC_SEARCH_LIBS(atanh, m, AC_DEFINE_UNQUOTED(HAVE_ATANH, 1, [If we have atanh()])) dnl ------------------- dnl Check for socklen_t dnl ------------------- AC_MSG_CHECKING(for socklen_t) AC_TRY_COMPILE([#include <sys/types.h> #include <sys/socket.h> ], [socklen_t x; ], [AC_MSG_RESULT(yes)], [ AC_TRY_COMPILE([#include <sys/types.h> #include <sys/socket.h> ], [int accept(int, struct sockaddr *, size_t *); ], [ AC_MSG_RESULT(size_t) AC_DEFINE(socklen_t, size_t)], [ AC_MSG_RESULT(int) AC_DEFINE(socklen_t, int)])]) dnl ----------------------------------- dnl Check if linux needs asm/sigcontext dnl ----------------------------------- case "$host_os" in linux*) AC_MSG_CHECKING(if struct sigcontext needs asm/sigcontext.h) AC_TRY_COMPILE([#include <signal.h> ], [struct sigcontext p; ], [AC_MSG_RESULT(no)], [ AC_MSG_RESULT(yes) AC_DEFINE(LINUX_NEEDS_ASM_SIGCONTEXT)]) esac dnl ------------------------- dnl Check if sigssetjmp works dnl ------------------------- dnl This test was ripped from gnuplot's configure.in: AC_MSG_CHECKING([for sigsetjmp]) AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <setjmp.h>]], [[jmp_buf env; sigsetjmp(env, 1);]])], [AC_MSG_RESULT(yes) AC_DEFINE(HAVE_SIGSETJMP)],[AC_MSG_RESULT(no)]) dnl ------------------------ dnl Check if sigaction works dnl ------------------------ if test "$WINDOWS" = no; then AC_MSG_CHECKING([for a working sigaction]) echo '#include "confdefs.h"' > conftest.c cat $srcdir/EnginePl/try_sigaction.c >> conftest.c (eval $ac_link) 2>&5 if test -s conftest && ./conftest; then AC_MSG_RESULT(yes) AC_DEFINE(HAVE_WORKING_SIGACTION) else AC_MSG_RESULT(no) fi fi dnl -------------------------------------- dnl Check if obj_chain needs reverse order dnl -------------------------------------- if test "$GCC" = yes; then AC_MSG_CHECKING([constructors execution order]) for i in 0 1; do echo '#include "confdefs.h"' > conftest-$i.c echo 'extern int first_to_last;' >>conftest-$i.c echo "static void __attribute__ ((constructor)) mycons(void) { first_to_last = $i; }" >>conftest-$i.c done echo '#include "confdefs.h"' > conftest.c echo 'int first_to_last;' >>conftest.c echo 'int main () { return first_to_last ? 0 : 1; }' >>conftest.c (eval $CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS $LIBS conftest-0.c conftest-1.c conftest.c >&5) 2>&5 if test -x conftest && ./conftest; then AC_MSG_RESULT(first to last) AC_DEFINE(OBJ_CHAIN_REVERSE_ORDER) else AC_MSG_RESULT(last to first) fi fi dnl ********************* dnl * LD compiler flags * dnl ********************* # Check whether -static-libgcc is supported (could add -static-libstdc++ later) # This is to avoid on windows a dependency to mingw dll (e.g. libgcc_s_sjlj.dll) have_static_libs=no if test "$GCC" = yes -a "$WINDOWS" != no; then SAVE_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS -static-libgcc" AC_MSG_CHECKING([whether gcc accepts -static-libgcc]) AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])], [AC_MSG_RESULT([yes]); have_static_libs=yes], [AC_MSG_RESULT([no])]) if test "$have_static_libs" = no; then LDFLAGS="$SAVE_LDFLAGS" fi fi # On windows, check whether ld accepts an option # to disable the large address awareness, else use # peflags -l0 EXECUTABLE.EXE for each created executable (e.g. pl2wam.exe) accept_disable_large_address_aware=no if test "$GCC" = yes -a "$CYGWIN" = yes; then SAVE_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS -Wl,--disable-large-address-aware" AC_MSG_CHECKING([whether gcc accepts -Wl,--disable-large-address-aware]) AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])], [AC_MSG_RESULT([yes]); accept_disable_large_address_aware=yes], [AC_MSG_RESULT([no])]) if test "$accept_disable_large_address_aware" = no; then LDFLAGS="$SAVE_LDFLAGS" fi fi dnl ******************** dnl * libraries to add * dnl ******************** if test "$WITH_MSVC" != no; then LDFLAGS='-nologo -F8000000' fi make_lib_list() { list='' if test $CC = cl -o $CC = lcc; then for i; do list="$list $i.lib"; done else for i; do list="$list -l$i"; done fi echo $list } if test "$USE_GUI_CONSOLE" = yes -a \( "$USE_LINEDIT" = no -o "$WINDOWS" = no \) then AC_DEFINE(NO_USE_GUI_CONSOLE) USE_GUI_CONSOLE=no fi if test "$USE_GUI_CONSOLE" != yes then WITH_HTMLHELP=no fi if test "$WINDOWS" != no; then LIB='advapi32 user32' GUILIB='kernel32 user32 gdi32 comdlg32 advapi32 comctl32 shell32 ole32 winmm' dnl winmm is for the sound PlaySound in the GUI dnl other libs: winspool.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib case "$WITH_HTMLHELP" in static) AC_DEFINE(WITH_HTMLHELP, 1) GUILIB="$GUILIB htmlhelp";; dynamic) AC_DEFINE(WITH_HTMLHELP, 2);; *) WITH_HTMLHELP=no esac if test "$USE_SOCKETS" = yes; then LIB="$LIB ws2_32" fi else LIB='m' GUILIB='' if test "$USE_SOCKETS" = yes; then AC_CHECK_FUNC(socket,[], AC_CHECK_LIB(socket,socket,LIB="$LIB socket", AC_MSG_ERROR(cannot find socket library))) AC_CHECK_FUNC(gethostbyname,[], AC_CHECK_LIB(nsl,gethostbyname,LIB="$LIB nsl")) dnl (No error here; just assume gethostbyname is in -lsocket.) fi fi LDLIBS=`make_lib_list $LIB` LDGUILIBS=`make_lib_list $GUILIB` CFLAGS=$SAVE_CFLAGS dnl *********************** dnl * gp_config.h defines * dnl *********************** AC_DEFINE_UNQUOTED(PROLOG_NAME, "$PROLOG_NAME") AC_DEFINE_UNQUOTED(PROLOG_DIALECT, "$PROLOG_DIALECT") AC_DEFINE_UNQUOTED(PROLOG_VERSION, "$PROLOG_VERSION") AC_DEFINE_UNQUOTED(PROLOG_DATE, "$PROLOG_DATE") AC_DEFINE_UNQUOTED(PROLOG_COPYRIGHT, "$PROLOG_COPYRIGHT") AC_DEFINE_UNQUOTED(TOP_LEVEL, "$TOP_LEVEL") AC_DEFINE_UNQUOTED(GPLC, "$GPLC") AC_DEFINE_UNQUOTED(HEXGPLC, "$HEXGPLC") AC_DEFINE_UNQUOTED(ENV_VARIABLE, "$ENV_VARIABLE") AC_DEFINE_UNQUOTED(M_CPU, "$host_cpu") AC_DEFINE_UNQUOTED(M_VENDOR, "$host_vendor") AC_DEFINE_UNQUOTED(M_OS, "$host_os") AC_DEFINE_UNQUOTED(CC, "$CC") AC_DEFINE_UNQUOTED(CFLAGS_PREFIX_REG,"$CFLAGS_PREFIX_REG") AC_DEFINE_UNQUOTED(CFLAGS, "$CFLAGS") AC_DEFINE_UNQUOTED(CFLAGS_MACHINE, "$CFLAGS_MACHINE") AC_DEFINE_UNQUOTED(LDFLAGS, "$LDFLAGS") AC_DEFINE_UNQUOTED(LDLIBS, "$LDLIBS") AC_DEFINE_UNQUOTED(AS, "$AS") AC_DEFINE_UNQUOTED(ASFLAGS, "$ASFLAGS") AC_DEFINE_UNQUOTED(STRIP, "$STRIP") AC_DEFINE_UNQUOTED(ASM_SUFFIX, "$ASM_SUFFIX") AC_DEFINE_UNQUOTED(OBJ_SUFFIX, "$OBJ_SUFFIX") AC_DEFINE_UNQUOTED(EXE_SUFFIX, "$EXE_SUFFIX") AC_DEFINE_UNQUOTED(CC_OBJ_NAME_OPT, "$CC_OBJ_NAME_OPT") AC_DEFINE_UNQUOTED(CC_EXE_NAME_OPT, "$CC_EXE_NAME_OPT") AC_DEFINE_UNQUOTED(DLL_W32GUICONS, "$DLL_W32GUICONS") AC_DEFINE_UNQUOTED(LIB_LINEDIT, "$LIB_LINEDIT") AC_DEFINE_UNQUOTED(LIB_ENGINE_PL, "$LIB_ENGINE_PL") AC_DEFINE_UNQUOTED(LIB_BIPS_PL, "$LIB_BIPS_PL") AC_DEFINE_UNQUOTED(LIB_ENGINE_FD, "$LIB_ENGINE_FD") AC_DEFINE_UNQUOTED(LIB_BIPS_FD, "$LIB_BIPS_FD") dnl *************** dnl * directories * dnl *************** dnl a function to compare 2 directories (avoid diff with trailing /) dnl does not take into account symlinks... same_directory() { f1=`dirname $1`/`basename $1` f2=`dirname $2`/`basename $2` test $f1 = $f2 } ROOT_DIR=`(cd .. ; pwd)` if test -x /bin/cygpath.exe; then ROOT_DIR1=`cygpath -a -w ..` else ROOT_DIR1=$ROOT_DIR fi test "$prefix" = NONE && prefix=/usr/local test "$exec_prefix" = NONE && exec_prefix=$prefix PKG_NAME=$PROLOG_DIALECT-$PROLOG_VERSION dnl *-------------* dnl * INSTALL_DIR * dnl *-------------* if test "$prefix" = in-place -o "$WITH_INSTALL_DIR" = in-place; then IN_PLACE=yes INSTALL_DIR=$ROOT_DIR test -z "$WITH_LINKS_DIR" && WITH_LINKS_DIR=no else IN_PLACE=no if test -z "$WITH_INSTALL_DIR"; then INSTALL_DIR=$prefix/$PKG_NAME else INSTALL_DIR=$WITH_INSTALL_DIR fi fi dnl *-----------* dnl * LINKS_DIR * dnl *-----------* case "$WITH_LINKS_DIR" in no) LINKS_DIR=none;; '') LINKS_DIR=$exec_prefix/bin;; *) LINKS_DIR=$WITH_LINKS_DIR;; esac dnl *---------* dnl * DOC_DIR * dnl *---------* case "$WITH_DOC_DIR" in no) DOC_DIR=none; test -z "$WITH_HTML_DIR" && WITH_HTML_DIR=$INSTALL_DIR/doc/html_node;; '') DOC_DIR=$INSTALL_DIR/doc;; *) DOC_DIR=$WITH_DOC_DIR;; esac if same_directory "$DOC_DIR" $ROOT_DIR/doc; then DOC_DIR=none fi dnl *----------* dnl * HTML_DIR * dnl *----------* case "$WITH_HTML_DIR" in no) HTML_DIR=none;; '') if test "$DOC_DIR" = none; then WITH_HTML_DIR=no; HTML_DIR=none else HTML_DIR=$DOC_DIR/html_node fi;; *) HTML_DIR=$WITH_HTML_DIR;; esac if same_directory "$HTML_DIR" $ROOT_DIR/doc/html_node; then HTML_DIR=none fi dnl *--------------* dnl * EXAMPLES_DIR * dnl *--------------* case "$WITH_EXAMPLES_DIR" in no) EXAMPLES_DIR=none;; '') EXAMPLES_DIR=$INSTALL_DIR/examples;; *) EXAMPLES_DIR=$WITH_EXAMPLES_DIR;; esac if same_directory "$EXAMPLES_DIR" $ROOT_DIR/examples; then EXAMPLES_DIR=none fi dnl *---------* dnl * Summary * dnl *---------* echo 'DIRECTORIES' echo "--> Installation: $INSTALL_DIR" echo "--> Link to binaries: $LINKS_DIR" echo "--> Documentation: $DOC_DIR" echo "--> HTML documentation: $HTML_DIR" echo "--> Examples: $EXAMPLES_DIR" dnl ****************** dnl * sub-components * dnl ****************** if test "$IN_PLACE" = no; then TXT_FILES='README COPYING VERSION NEWS ChangeLog gprolog.ico' else TXT_FILES= fi BIN_FILES= OBJ_FILES= LIB_FILES= INC_FILES="$PROLOG_DIALECT.h fd_to_c.h" DOC_FILES='???*.dvi ???*.ps ???*.pdf ???*.chm ???*.eps ???*.html ???*.gif' HTML_FILES='???*.html ???*.gif ???*.css' EXPL_FILES='Makefile README PROGS ??*.pl' EXC_FILES='Makefile README ??*.pl ??*_c.c' EXFD_FILES='Makefile ??*.pl ??*.fd' B="$GPLC $HEXGPLC $TOP_LEVEL pl2wam wam2ma ma2asm" O="top_level all_pl_bips debugger" L="$LIB_ENGINE_PL $LIB_BIPS_PL" if test "$USE_LINEDIT" = yes; then MAKE_LE_DIRS='$(LE_DIRS)' MAKE_LE_INTERF_OBJS='$(LE_INTERF_OBJS)' L="$L $LIB_LINEDIT" else MAKE_LE_DIRS= MAKE_LE_INTERF_OBJS='$(NO_LE_INTERF_OBJS)' fi if test "$USE_GUI_CONSOLE" = yes; then TOP_LEVEL_FLAGS=--gui-console MAKE_W32GC_DIRS='$(W32GC_DIRS)' O="$O w32gc_interf" BIN_FILES="$DLL_W32GUICONS" else TOP_LEVEL_FLAGS= MAKE_W32GC_DIRS= fi if test "$USE_SOCKETS" = yes; then MAKE_SOCKETS_OBJS='$(SOCKETS_OBJS)' else MAKE_SOCKETS_OBJS='$(NO_SOCKETS_OBJS)' fi if test "$USE_FD_SOLVER" = yes; then MAKE_FD_DIRS='$(FD_DIRS)' B="$B fd2c" L="$L $LIB_ENGINE_FD $LIB_BIPS_FD" O="$O all_fd_bips" else MAKE_FD_DIRS= fi for i in $B; do BIN_FILES="$BIN_FILES $i$EXE_SUFFIX" done for i in $O; do OBJ_FILES="$OBJ_FILES $i$OBJ_SUFFIX" done if test "$USE_GUI_CONSOLE" = yes; then OBJ_FILES="$OBJ_FILES win_exe_icon.res" fi LIB_FILES=$L dnl *********************** dnl * Version & Copyright * dnl *********************** echo "$PKG_NAME" >VERSION echo "$PKG_NAME" >../VERSION echo "$PROLOG_VERSION" >/tmp/version_no.tex if diff /tmp/version_no.tex ../doc/version_no.tex >/dev/null 2>&1; then rm /tmp/version_no.tex else mv /tmp/version_no.tex ../doc/version_no.tex fi echo "$PROLOG_COPYRIGHT" >/tmp/copyright.tex if diff /tmp/copyright.tex ../doc/copyright.tex >/dev/null 2>&1; then rm /tmp/copyright.tex else mv /tmp/copyright.tex ../doc/copyright.tex fi dnl ******************** dnl * Files generation * dnl ******************** OTHER_DOT_IN_FILES= for i in TestsPl/Makefile DevUtils/Makefile Ma2Asm/FromC/Makefile Win32/Makefile Win32/gp-vars-iss.txt do if test -f $i.in; then OTHER_DOT_IN_FILES="$OTHER_DOT_IN_FILES $i" fi done AC_CONFIG_HEADER(EnginePl/gp_config.h) AC_CONFIG_FILES(Makefile TopComp/Makefile Pl2Wam/Makefile Wam2Ma/Makefile Ma2Asm/Makefile Fd2C/Makefile Linedit/Makefile W32GUICons/Makefile EnginePl/Makefile BipsPl/Makefile EngineFD/Makefile BipsFD/Makefile $OTHER_DOT_IN_FILES) AC_OUTPUT ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/CSHSETVARS������������������������������������������������������������������������0000644�0001750�0001750�00000000221�13021324543�013511� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������set a=`pwd` setenv PATH $a/TopComp:$a/EnginePl:$a/Pl2Wam:$a/Wam2Ma:$a/Ma2Asm:$a/Fd2C:$a/DevUtils:$a/W32GUICons:"$PATH":/usr/ucb/:/usr/ccs/bin/ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/AUTOCONF-INFO���������������������������������������������������������������������0000644�0001750�0001750�00000017230�13021324543�014003� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Basic Installation ================== These are generic installation instructions. The `configure' shell script attempts to guess correct values for various system-dependent variables used during compilation. It uses those values to create a `Makefile' in each directory of the package. It may also create one or more `.h' files containing system-dependent definitions. Finally, it creates a shell script `config.status' that you can run in the future to recreate the current configuration, a file `config.cache' that saves the results of its tests to speed up reconfiguring, and a file `config.log' containing compiler output (useful mainly for debugging `configure'). If you need to do unusual things to compile the package, please try to figure out how `configure' could check whether to do them, and mail diffs or instructions to the address given in the `README' so they can be considered for the next release. If at some point `config.cache' contains results you don't want to keep, you may remove or edit it. The file `configure.in' is used to create `configure' by a program called `autoconf'. You only need `configure.in' if you want to change it or regenerate `configure' using a newer version of `autoconf'. The simplest way to compile this package is: 1. `cd' to the directory containing the package's source code and type `./configure' to configure the package for your system. If you're using `csh' on an old version of System V, you might need to type `sh ./configure' instead to prevent `csh' from trying to execute `configure' itself. Running `configure' takes awhile. While running, it prints some messages telling which features it is checking for. 2. Type `make' to compile the package. 3. Optionally, type `make check' to run any self-tests that come with the package. 4. Type `make install' to install the programs and any data files and documentation. 5. You can remove the program binaries and object files from the source code directory by typing `make clean'. To also remove the files that `configure' created (so you can compile the package for a different kind of computer), type `make distclean'. There is also a `make maintainer-clean' target, but that is intended mainly for the package's developers. If you use it, you may have to get all sorts of other programs in order to regenerate files that came with the distribution. Compilers and Options ===================== Some systems require unusual options for compilation or linking that the `configure' script does not know about. You can give `configure' initial values for variables by setting them in the environment. Using a Bourne-compatible shell, you can do that on the command line like this: CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure Or on systems that have the `env' program, you can do it like this: env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure Compiling For Multiple Architectures ==================================== You can compile the package for more than one kind of computer at the same time, by placing the object files for each architecture in their own directory. To do this, you must use a version of `make' that supports the `VPATH' variable, such as GNU `make'. `cd' to the directory where you want the object files and executables to go and run the `configure' script. `configure' automatically checks for the source code in the directory that `configure' is in and in `..'. If you have to use a `make' that does not supports the `VPATH' variable, you have to compile the package for one architecture at a time in the source code directory. After you have installed the package for one architecture, use `make distclean' before reconfiguring for another architecture. Installation Names ================== By default, `make install' will install the package's files in `/usr/local/bin', `/usr/local/man', etc. You can specify an installation prefix other than `/usr/local' by giving `configure' the option `--prefix=PATH'. You can specify separate installation prefixes for architecture-specific files and architecture-independent files. If you give `configure' the option `--exec-prefix=PATH', the package will use PATH as the prefix for installing programs and libraries. Documentation and other data files will still use the regular prefix. In addition, if you use an unusual directory layout you can give options like `--bindir=PATH' to specify different values for particular kinds of files. Run `configure --help' for a list of the directories you can set and what kinds of files go in them. If the package supports it, you can cause programs to be installed with an extra prefix or suffix on their names by giving `configure' the option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. Optional Features ================= Some packages pay attention to `--enable-FEATURE' options to `configure', where FEATURE indicates an optional part of the package. They may also pay attention to `--with-PACKAGE' options, where PACKAGE is something like `gnu-as' or `x' (for the X Window System). The `README' should mention any `--enable-' and `--with-' options that the package recognizes. For packages that use the X Window System, `configure' can usually find the X include and library files automatically, but if it doesn't, you can use the `configure' options `--x-includes=DIR' and `--x-libraries=DIR' to specify their locations. Specifying the System Type ========================== There may be some features `configure' can not figure out automatically, but needs to determine by the type of host the package will run on. Usually `configure' can figure that out, but if it prints a message saying it can not guess the host type, give it the `--host=TYPE' option. TYPE can either be a short name for the system type, such as `sun4', or a canonical name with three fields: CPU-COMPANY-SYSTEM See the file `config.sub' for the possible values of each field. If `config.sub' isn't included in this package, then this package doesn't need to know the host type. If you are building compiler tools for cross-compiling, you can also use the `--target=TYPE' option to select the type of system they will produce code for and the `--build=TYPE' option to select the type of system on which you are compiling the package. Sharing Defaults ================ If you want to set default values for `configure' scripts to share, you can create a site shell script called `config.site' that gives default values for variables like `CC', `cache_file', and `prefix'. `configure' looks for `PREFIX/share/config.site' if it exists, then `PREFIX/etc/config.site' if it exists. Or, you can set the `CONFIG_SITE' environment variable to the location of the site script. A warning: not all `configure' scripts look for a site script. Operation Controls ================== `configure' recognizes the following options to control how it operates. `--cache-file=FILE' Use and save the results of the tests in FILE instead of `./config.cache'. Set FILE to `/dev/null' to disable caching, for debugging `configure'. `--help' Print a summary of the options to `configure', and exit. `--quiet' `--silent' `-q' Do not print messages saying which checks are being made. To suppress all normal output, redirect it to `/dev/null' (any error messages will still be shown). `--srcdir=DIR' Look for the package's source code in directory DIR. Usually `configure' can determine that directory automatically. `--version' Print the version of Autoconf used to generate the `configure' script, and exit. `configure' also accepts some other, not widely useful, options. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/���������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013172� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/chkma_ma.ma����������������������������������������������������������������0000644�0001750�0001750�00000015304�13021324543�015250� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������;/*-------------------------------------------------------------------------* ; * GNU Prolog * ; * * ; * Part : mini-assembler to assembler translator * ; * File : chkma_ma.ma * ; * Descr.: test file for MA translation * ; * Author: Daniel Diaz * ; * * ; * Copyright (C) 1999-2015 Daniel Diaz * ; * * ; * This file is part of GNU Prolog * ; * * ; * GNU Prolog is free software: you can redistribute it and/or * ; * modify it under the terms of either: * ; * * ; * - the GNU Lesser General Public License as published by the Free * ; * Software Foundation; either version 3 of the License, or (at your * ; * option) any later version. * ; * * ; * or * ; * * ; * - 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. * ; * * ; * or both in parallel, as here. * ; * * ; * GNU Prolog 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 copies of the GNU General Public License and * ; * the GNU Lesser General Public License along with this program. If * ; * not, see http://www.gnu.org/licenses/. * ; *-------------------------------------------------------------------------*/ ; maybe comment this if something goes wrong from start ; (maybe it is call_c which does not work !) c_code initializer Object_Initializer call_c Initializer() c_ret pl_code global ma_test_pl_jump_and_pl_ret ; call_c Write_Long(&X(0)) ; pl_ret pl_jump ma_test_ret pl_code global ma_test_ret pl_ret pl_code global ma_test_pl_call_and_pl_ret_and_pl_fail pl_call ma_test_pl_jump_and_pl_ret pl_fail pl_code global ma_test_prep_cp_and_here_cp call_c Save_CP() prep_cp pl_jump ma_test_ret pl_fail here_cp call_c Restore_CP() pl_ret c_code global ma_test_jump_and_c_ret jump lab1 pl_fail lab1: jump lab2 pl_fail lab2: c_ret pl_code global ma_test_call_c call_c fast test_call_c1() pl_ret pl_code global ma_test_move_x_y call_c fast Allocate(1) move X(0),Y(3) move X(10),Y(0) move X(255),Y(15) pl_ret pl_code global ma_test_move_y_x call_c fast Allocate(1) move Y(0),X(0) move Y(10),X(31) move Y(23),X(12) pl_ret pl_code global ma_test_arg_int call_c fast test_arg_int1(12,-1,4095,123456789) pl_ret pl_code global ma_test_arg_double call_c fast test_arg_double1(12.456,-1.3e-102,-3.141593,12.456,-1.3e-102,-3.141593) pl_ret pl_code global ma_test_arg_mixed call_c fast test_arg_mixed1(-19, 12.456, -1.3e-102,365, 987654321, -3.141593, -110101) pl_ret pl_code global ma_test_arg_string call_c fast test_arg_string1("a string","abcd\01489d\37711ef\n\r") pl_ret pl_code global ma_test_arg_mem_l call_c fast test_arg_mem_l1(ma_local_var2,ma_global_var2,&test_arg_mem_l,ma_array(0),ma_array(4097),&ma_array(4500)) pl_ret pl_code global ma_test_arg_x call_c fast test_arg_x1(X(0),&X(0),X(255),&X(128)) pl_ret pl_code global ma_test_arg_y call_c fast Allocate(1) call_c fast test_arg_y1(Y(0),&Y(0),Y(12),&Y(6)) pl_ret pl_code global ma_test_arg_fl_array call_c fast Allocate(1) call_c fast test_arg_fl_array1(FL(0),FL(10),&FL(0),&FL(56)) pl_ret pl_code global ma_test_arg_fd_array call_c fast Allocate(1) call_c fast test_arg_fd_array1(FD(0),FD(47),&FD(0),&FD(127)) pl_ret pl_code global ma_test_call_c_lot_args call_c fast Allocate(1) call_c fast test_call_c_lot_args1(0,0,0,0,0,0,&test_call_c_lot_args,ma_local_var2,4095,123456789,-3.141593,"abcd\01489def\n\r",X(0),&X(0),X(255),&X(128),Y(0),&Y(0),Y(12),&Y(6), 1.23456) pl_ret pl_code global ma_test_jump_ret call_c fast test_jump_ret1(&ma_test_jump_ret1) jump_ret pl_ret pl_code global ma_test_jump_ret1 call_c fast test_jump_ret2() pl_ret pl_code global ma_test_fail_ret call_c fast test_fail_ret1() fail_ret pl_ret pl_code global ma_test_move_ret_mem call_c fast test_move_ret_mem1() move_ret ma_global_var1 call_c fast test_move_ret_mem1() move_ret ma_array(64) call_c fast test_move_ret_mem1() move_ret ma_array(4097) pl_ret pl_code global ma_test_move_ret_x call_c fast test_move_ret_x1() move_ret X(0) call_c fast test_move_ret_x1() move_ret X(255) pl_ret pl_code global ma_test_move_ret_y call_c fast Allocate(1) call_c fast test_move_ret_y1() move_ret Y(0) call_c fast test_move_ret_y1() move_ret Y(11) pl_ret pl_code global ma_test_move_ret_fl call_c fast Allocate(1) call_c fast test_move_ret_fl1() move_ret FL(0) call_c fast test_move_ret_fl1() move_ret FL(11) pl_ret pl_code global ma_test_move_ret_fd call_c fast Allocate(1) call_c fast test_move_ret_fd1() move_ret FD(0) call_c fast test_move_ret_fd1() move_ret FD(11) pl_ret pl_code global ma_test_switch_ret call_c fast test_switch_ret1() switch_ret (0=sl0,4=sl1,15=sl2,4095=sl3,123456=sl4,2456789=sl5) sl0: call_c fast test_switch_ret2(0) pl_ret sl1: call_c fast test_switch_ret2(1) pl_ret sl2: call_c fast test_switch_ret2(2) pl_ret sl3: call_c fast test_switch_ret2(3) pl_ret sl4: call_c fast test_switch_ret2(4) pl_ret sl5: call_c fast test_switch_ret2(5) pl_ret ; ma_array must be just before ma_global_var1 (in alphabetic order) long global ma_array(5000) long global ma_global_var1 long global ma_global_var2 = 12345 long local ma_local_var1 long local ma_local_var2 = 128 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/ix86_any.c�����������������������������������������������������������������0000644�0001750�0001750�00000106613�13021324543�015006� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : ix86_any.c * * Descr.: translation file for Linux/Cygwin/mingw32/... on intel x86 * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> /* For M_ix86_darwin: an important point is the C stack must be aligned * on 16 bytes. It is possible to use gcc option -mstackrealign but * it produces bigger and slower code (and uses %ecx as register). * If this is not done and if the called function performs a movdqa * an error will occur (generally Bus Error). * Just before calling a function %esp is 16bytes aligned, %esp = 0x...0 * (4 low bits = 0). The call instruction pushes the return address, so at * the entry of a function, %esp is 0x...c. Gcc then adjusts (via subl) * %esp to be 0x...0 before calling a function. We mimic the same modifying * Call_Compiled to force %esp to be 0x...0 when arriving in a Prolog code. * So a Prolog code can call C functions safely. * When a Prolog code finishes it returns into C inside Call_Prolog_Success * or Call_Prolog_Fail. In both functions we re-adjust the stack (gcc thinks * %esp = 0x...c while it is 0x...0): after the gcc adjustment code we * force %esp to be 0x...0. * For MA c_code (MA code called by a C function), we have to reserve enough * space in the stack to pass args to C functions. We receive %esp = 0x...c * In addition we have to push 2 registers (%ebp = PB_REG and %esi) * Thus 0x...c - 4 - 4 = 0x...4. We have to sub 4 to %esp and the space for * MAX_C_ARGS_IN_C_CODE*4 (this is OK if MAX_C_ARGS_IN_C_CODE is a multiple * of 4). So we have to reserve: 4 + MAX_C_ARGS_IN_C_CODE * 4. */ /*---------------------------------* * Constants * *---------------------------------*/ #define STRING_PREFIX ".LC" #define MAX_C_ARGS_IN_C_CODE 32 /* must be a multiple of 4 for darwin */ #define RESERVED_STACK_SPACE MAX_C_ARGS_IN_C_CODE * 4 + 4 #if defined(__CYGWIN__) || defined (_WIN32) || defined(M_ix86_darwin) #define UN "_" #else #define UN #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ extern int pic_code; char asm_reg_e[20]; char asm_reg_b[20]; char asm_reg_cp[20]; int w_label = 0; char *fc_arg_regs[] = FC_SET_OF_REGISTERS; int stack_offset = 0; /* offset wrt esp to store the next argument in the stack */ int fc_reg_no = 0; /* index wrt fc_arg_reg to store the next arg in a FC reg */ int eax_used_as_fc_reg = 0; /* is eax already containing an arg (FC) ? */ /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 1; #ifndef M_solaris char *comment_prefix = "#"; #else char *comment_prefix = "/"; #endif #ifdef M_ix86_darwin char *local_symb_prefix = "L"; #else char *local_symb_prefix = ".L"; #endif #ifdef M_ix86_darwin int strings_need_null = 1; #else int strings_need_null = 0; #endif int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static char *Off_Reg_Bank(int offset); #ifdef M_ix86_darwin #define DARWIN_PB_REG "%ebp" /* PIC BASE (PB) customization */ int load_pb_reg = 0; int pb_label_no = 0; char pb_label[32]; int needs_pre_pass = 1; /* overwritte var of ma_parser.c */ #include "../Wam2Ma/bt_string.h" BTString bt_stub; BTString bt_non_lazy; void Emit_Non_Lazy(int str_no, char *name); void Emit_Stub(int str_no, char *name); #endif /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { #ifdef NO_MACHINE_REG_FOR_REG_BANK #define ASM_REG_BANK UN "pl_reg_bank" #elif defined(MAP_REG_BANK) #define ASM_REG_BANK "%" MAP_REG_BANK #else #define ASM_REG_BANK "%ebx" #endif #ifdef MAP_REG_E sprintf(asm_reg_e, "%%%s", MAP_REG_E); #else strcpy(asm_reg_e, "%edi"); #endif #ifdef MAP_REG_B sprintf(asm_reg_b, "%%%s", MAP_REG_B); #else strcpy(asm_reg_b, Off_Reg_Bank(MAP_OFFSET_B)); #endif #ifdef MAP_REG_CP sprintf(asm_reg_cp, "%%%s", MAP_REG_CP); #else strcpy(asm_reg_cp, Off_Reg_Bank(MAP_OFFSET_CP)); #endif Inst_Printf(".text", ""); Label("fail"); Pl_Fail(); #ifdef M_ix86_darwin BT_String_Init(&bt_stub); BT_String_Init(&bt_non_lazy); #endif } /*-------------------------------------------------------------------------* * OFF_REG_BANK * * * *-------------------------------------------------------------------------*/ static char * Off_Reg_Bank(int offset) { static char str[20]; #ifdef NO_MACHINE_REG_FOR_REG_BANK sprintf(str, ASM_REG_BANK "+%d", offset); #else sprintf(str, "%d(%s)", offset, ASM_REG_BANK); #endif return str; } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { #ifdef __ELF__ Inst_Printf(".section", ".note.GNU-stack,\"\",@progbits"); #endif #ifdef M_ix86_darwin if (bt_non_lazy.nb_elem) { Inst_Printf(".section __IMPORT,__pointers,non_lazy_symbol_pointers", ""); BT_String_List(&bt_non_lazy, Emit_Non_Lazy); } if (bt_stub.nb_elem) { Inst_Printf(".section __IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5", ""); BT_String_List(&bt_stub, Emit_Stub); } Inst_Printf(".subsections_via_symbols", ""); Inst_Printf(".section", "__TEXT,__textcoal_nt,coalesced,pure_instructions"); Label_Printf(".weak_definition\t___i686.get_pc_thunk.%s", DARWIN_PB_REG + 2); Label_Printf(".private_extern ___i686.get_pc_thunk.%s", DARWIN_PB_REG + 2); Label_Printf("___i686.get_pc_thunk.%s:", DARWIN_PB_REG + 2); Inst_Printf("movl", "(%%esp), %s", DARWIN_PB_REG); Inst_Printf("ret", ""); #endif } #ifdef M_ix86_darwin void Emit_Non_Lazy(int str_no, char *name) { Label_Printf("L_%s$non_lazy_ptr:", name); Label_Printf("\t.indirect_symbol _%s", name); Inst_Printf(".long", "0"); } void Emit_Stub(int str_no, char *name) { Label_Printf("L_%s$stub:", name); Label_Printf(".indirect_symbol _%s", name); Inst_Printf("hlt ; hlt ; hlt ; hlt ; hlt", ""); } void Load_PB_Reg(void) { if (!load_pb_reg) return; int i; Inst_Printf("call", "___i686.get_pc_thunk.%s", DARWIN_PB_REG + 2); i = sprintf(pb_label, "\"L%011d$pb\"", ++pb_label_no); Label_Printf("%s:", pb_label); sprintf(pb_label + i, "(%s)", DARWIN_PB_REG); load_pb_reg = 0; } #endif /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { #ifdef M_solaris Inst_Printf(".align", "4"); #elif defined(M_ix86_darwin) #else Inst_Printf(".p2align", "4,,15"); #endif #if defined(M_ix86_linux) || defined(M_ix86_bsd) || defined(M_ix86_sco) Inst_Printf(".type", UN "%s,@function", label); #endif if (global) Label_Printf(".globl " UN "%s", label); Label(label); if (!prolog) { #ifdef M_ix86_darwin Inst_Printf("pushl", "%s", DARWIN_PB_REG); #endif Inst_Printf("pushl", "%%esi"); /* used as r_aux when %eax is a FC reg */ Inst_Printf("subl", "$%d,%%esp", RESERVED_STACK_SPACE); } } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf(""); #if 0 Inst_Printf(".align", "4"); #endif Label_Printf(UN "%s:", label); #ifdef M_ix86_darwin load_pb_reg = 1; #endif } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { #ifndef MAP_REG_E Inst_Printf("movl", "%s,%s", Off_Reg_Bank(MAP_OFFSET_E), asm_reg_e); #endif } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { #ifdef M_ix86_darwin if (!Is_Code_Defined(label)) { BT_String_Add(&bt_stub, strdup(label)); Inst_Printf("jmp", "L_%s$stub", label); } else #endif Inst_Printf("jmp", UN "%s", label); } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { #ifdef M_ix86_darwin Load_PB_Reg(); Inst_Printf("leal", "Lcont%d-%s,%%eax", w_label, pb_label); Inst_Printf("movl", "%%eax,%s", asm_reg_cp); #else Inst_Printf("movl", "$.Lcont%d,%s", w_label, asm_reg_cp); #endif } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf("%scont%d:", local_symb_prefix, w_label++); #ifdef M_ix86_darwin load_pb_reg = 1; #endif } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Prep_CP(); Pl_Jump(label); Here_CP(); } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Inst_Printf("jmp", "*-4(%s)", asm_reg_b); #else Inst_Printf("movl", "%s,%%eax", asm_reg_b); Inst_Printf("jmp", "*-4(%%eax)"); #endif } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { #ifndef MAP_REG_CP Inst_Printf("jmp", "*%s", asm_reg_cp); #else Inst_Printf("jmp", "%s", asm_reg_cp); #endif } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { Inst_Printf("jmp", UN "%s", label); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Inst_Printf("movl", "%s,%%eax", Off_Reg_Bank(index * 4)); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { Inst_Printf("movl", "%d(%s),%%eax", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Inst_Printf("movl", "%%eax,%s", Off_Reg_Bank(index * 4)); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { Inst_Printf("movl", "%%eax,%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { #ifndef FC_USED_TO_COMPILE_CORE if (p_inline == NULL) /* inlined code used a fast call */ fc = 0; #endif stack_offset = 0; if (fc) fc_reg_no = 0; else fc_reg_no = FC_MAX_ARGS_IN_REGS; /* so no more regs left to use */ eax_used_as_fc_reg = 0; } #define BEFORE_ARG \ { \ char r[10], *r_aux; \ int r_eq_r_aux = 0; \ \ if (fc_reg_no < FC_MAX_ARGS_IN_REGS) \ { \ strcpy(r, fc_arg_regs[fc_reg_no++]); \ if (strcmp("%eax", r) == 0) \ eax_used_as_fc_reg = 1; \ r_aux = r; \ r_eq_r_aux = 1; \ } \ else \ { \ sprintf(r, "%d(%%esp)", stack_offset * 4); \ stack_offset++; \ r_aux = (eax_used_as_fc_reg) ? "%esi" : "%eax"; \ } /* In GCC 3, the 3 first args are passed via registers if they are * ints (recall: 1 double = 2 ints). So if the 2 first args are * double (4 ints) nothing is passed in registers. * In GCC 4, the 3 first int args are passed in register whatever * the previous arg types. */ #if __GNUC__ >= 4 || defined(_MSC_VER) #define SKIP_FC_REG #else #define SKIP_FC_REG fc_reg_no++ #endif #define BEFORE_HALF_ARG_DOUBLE \ { \ char r[10], *r_aux; \ \ if (fc_reg_no < FC_MAX_ARGS_IN_REGS) \ SKIP_FC_REG; \ sprintf(r, "%d(%%esp)", stack_offset * 4); \ stack_offset++; \ r_aux = (eax_used_as_fc_reg) ? "%esi" : "%eax"; #define AFTER_ARG \ } /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { BEFORE_ARG; Inst_Printf("movl", "$%ld,%s", int_val, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { int *p = (int *) &dbl_val; BEFORE_HALF_ARG_DOUBLE; Inst_Printf("movl", "$%d,%s", p[0], r); AFTER_ARG; offset++; BEFORE_HALF_ARG_DOUBLE; Inst_Printf("movl", "$%d,%s", p[1], r); AFTER_ARG; return 2; } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { BEFORE_ARG; #ifdef M_ix86_darwin Load_PB_Reg(); Inst_Printf("leal", "%s%d-%s,%s", STRING_PREFIX, str_no, pb_label, r_aux); if (!r_eq_r_aux) Inst_Printf("movl", "%s,%s", r_aux, r); #else Inst_Printf("movl", "$%s%d,%s", STRING_PREFIX, str_no, r); #endif AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { #ifdef M_ix86_darwin int global, value; VType vtype; int is_a_long; #endif BEFORE_ARG; #ifdef M_ix86_darwin Load_PB_Reg(); is_a_long = Get_Long_Infos(name, &global, &vtype, &value); if ((is_a_long && global && vtype != INITIAL_VALUE) || (!is_a_long && !Is_Code_Defined(name))) /* external code */ { BT_String_Add(&bt_non_lazy, name); /* strdup done by parser */ Inst_Printf("movl", "L_%s$non_lazy_ptr-%s,%s", name, pb_label, r_aux); if (adr_of) { if (index > 0) Inst_Printf("addl", "$%d,%s", index * 4, r_aux); } else Inst_Printf("movl", "%d(%s),%s", index * 4, r_aux, r_aux); } else { if (adr_of) Inst_Printf("leal", "%d+_%s-%s,%s", index * 4, name, pb_label, r_aux); else Inst_Printf("movl", "%d+_%s-%s,%s", index * 4, name, pb_label, r_aux); } if (!r_eq_r_aux) Inst_Printf("movl", "%s,%s", r_aux, r); #else /* !M_ix86_darwin */ if (adr_of) Inst_Printf("movl", "$" UN "%s+%d,%s", name, index * 4, r); else { Inst_Printf("movl", UN "%s+%d,%s", name, index * 4, r_aux); if (!r_eq_r_aux) Inst_Printf("movl", "%s,%s", r_aux, r); } #endif AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) { if (!r_eq_r_aux && index == 0) { #ifdef NO_MACHINE_REG_FOR_REG_BANK Inst_Printf("movl", "$%s,%s", ASM_REG_BANK, r); #else Inst_Printf("movl", "%s,%s", ASM_REG_BANK, r); #endif goto finish; } Inst_Printf("leal", "%s,%s", Off_Reg_Bank(index * 4), r_aux); } else Inst_Printf("movl", "%s,%s", Off_Reg_Bank(index * 4), r_aux); if (!r_eq_r_aux) Inst_Printf("movl", "%s,%s", r_aux, r); finish: ; /* gcc3 does not like use of label at end of compound statement */ AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Inst_Printf("leal", "%d(%s),%s", Y_OFFSET(index), asm_reg_e, r_aux); else Inst_Printf("movl", "%d(%s),%s", Y_OFFSET(index), asm_reg_e, r_aux); if (!r_eq_r_aux) Inst_Printf("movl", "%s,%s", r_aux, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { return Call_C_Arg_Mem_L(offset, adr_of, "pl_foreign_long", index); } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { if (adr_of) return Call_C_Arg_Mem_L(offset, adr_of, "pl_foreign_double", index * 2); BEFORE_HALF_ARG_DOUBLE; #ifdef M_ix86_darwin Load_PB_Reg(); Inst_Printf("movl", "L_pl_foreign_double$non_lazy_ptr-%s,%s", pb_label, r_aux); Inst_Printf("movsd", "%d(%s),%%xmm0", index * 8, r_aux); Inst_Printf("movsd", "%%xmm0,%s", r); stack_offset++; #else /* !M_ix86_darwin */ Inst_Printf("movl", UN "pl_foreign_double+%d,%s", index * 8, r_aux); Inst_Printf("movl", "%s,%s", r_aux, r); AFTER_ARG; offset++; BEFORE_HALF_ARG_DOUBLE; Inst_Printf("movl", UN "pl_foreign_double+%d,%%eax", index * 8 + 4); Inst_Printf("movl", "%%eax,%s", r); #endif AFTER_ARG; return 2; } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { #if defined(_MSC_VER) && FC_MAX_ARGS_IN_REGS > 0 if (fc) { /* under MSVC: __fastcall implies decorated names @fct_name@nb_args_in_word * It also implies the callee pops the args then we have to readjust the stack. * I suppose this removes the benefit of passing args in stack: * by default it is switched off (see file arch_dep.h) */ Inst_Printf("call", "@%s@%d", fct_name, nb_args_in_words * sizeof(int)); if (stack_offset > 0) Inst_Printf("subl", "$%d,%%esp", stack_offset * 4); return; } #endif Inst_Printf("call", UN "%s", fct_name); } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { #ifndef MAP_REG_E if (p_inline && INL_ACCESS_INFO(p_inline)) reload_e = 1; #endif } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Inst_Printf("jmp", "*%%eax"); } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Inst_Printf("testl", "%%eax,%%eax"); Inst_Printf("je", UN "fail"); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { Inst_Printf("movl", "%%eax," UN "%s+%d", name, index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* same as Move_To_Reg_X */ Inst_Printf("movl", "%%eax,%s", Off_Reg_Bank(index * 4)); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* same as Move_To_Reg_Y */ Inst_Printf("movl", "%%eax,%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { Inst_Printf("movl", "%%eax," UN "pl_foreign_long+%d", index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { Inst_Printf("fstpl", UN "pl_foreign_double+%d", index * 8); } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { if (int_val == 0) Inst_Printf("testl", "%%eax,%%eax"); else Inst_Printf("cmpl", "$%ld,%%eax", int_val); } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Inst_Printf("je", UN "%s", label); } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { Inst_Printf("jg", UN "%s", label); } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Inst_Printf("addl", "$%d,%%esp", RESERVED_STACK_SPACE); Inst_Printf("popl", "%%esi"); #ifdef M_ix86_darwin Inst_Printf("popl", "%s", DARWIN_PB_REG); #endif Inst_Printf("ret", ""); } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { #if defined( __CYGWIN__) || defined (_WIN32) Inst_Printf(".section", ".rdata,\"dr\""); #elif defined(M_solaris) Inst_Printf(".section", ".rodata"); #elif defined(M_ix86_darwin) Inst_Printf(".cstring", ""); #else Inst_Printf(".section", ".rodata.str1.1,\"aMS\",@progbits,1"); #endif } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Label_Printf("%s%d:", STRING_PREFIX, str_no); #ifdef M_ix86_darwin Inst_Printf(".ascii", "%s", asciiz); #else Inst_Printf(".string", "%s", asciiz); #endif } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { Inst_Printf(".data", ""); #ifdef M_ix86_darwin Inst_Printf(".align", "2"); #else Inst_Printf(".align", "4"); #endif } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: #if defined(M_ix86_linux) || defined(M_ix86_sco) || \ defined(M_ix86_solaris) || defined(M_ix86_bsd) if (!global) Inst_Printf(".local", UN "%s", name); Inst_Printf(".comm", UN "%s,%ld,4", name, value * 4); #else if (!global) #ifdef M_ix86_darwin Inst_Printf(".lcomm", UN "%s,%ld,2", name, value * 4); #else Inst_Printf(".lcomm", UN "%s,%ld", name, value * 4); #endif else Inst_Printf(".comm", UN "%s,%ld", name, value * 4); #endif break; case INITIAL_VALUE: if (global) Label_Printf(".globl " UN "%s", name); #ifdef M_ix86_darwin Inst_Printf(".align", "2"); #else Inst_Printf(".align", "4"); #if !defined(__CYGWIN__) && !defined(_WIN32) Inst_Printf(".type", UN "%s,@object", name); Inst_Printf(".size", UN "%s,4", name); #endif #endif Label_Printf(UN "%s:", name); Inst_Printf(".long", "%ld", value); break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { if (initializer_fct == NULL) return; #if defined(M_ix86_darwin) Inst_Printf(".mod_init_func", ""); Inst_Printf(".align", "2"); Inst_Printf(".long", UN "%s", initializer_fct); #else #ifdef _MSC_VER Inst_Printf(".section", ".GPLC$m"); #elif defined( __CYGWIN__) || defined (_WIN32) Inst_Printf(".section", ".ctors,\"aw\""); #else Inst_Printf(".section", ".ctors,\"aw\",@progbits"); #endif Inst_Printf(".align", "4"); Inst_Printf(".long", UN "%s", initializer_fct); #endif /* M_ix86_darwin */ } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { } ���������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/ma2asm.c�������������������������������������������������������������������0000644�0001750�0001750�00000052472�13021324543�014524� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : ma2asm.c * * Descr.: code generation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <string.h> #include "../EnginePl/gp_config.h" #include "../Wam2Ma/bt_string.c" #include "../TopComp/copying.c" #define MA2ASM_FILE #include "ma_parser.h" #include "ma_protos.h" /*---------------------------------* * Constants * *---------------------------------*/ #define DEFAULT_OUTPUT_SUFFIX ASM_SUFFIX #define MASK_LONG_GLOBAL 1 #define MASK_LONG_INITIALIZED 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int global; VType vtype; /* NONE, INITIAL_VALUE, ARRAY_SZIE */ PlLong value; } LongInf; typedef struct { int prolog; int global; } CodeInf; /*---------------------------------* * Global Variables * *---------------------------------*/ char *file_name_in; char *file_name_out; int pic_code; int inline_asm; int ignore_fc; int comment; FILE *file_out; int work_label = 0; BTString bt_string; BTString bt_code; BTString bt_long; char *initializer_fct = NULL; /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Invoke_Dico_Long(int unused_no, char *name, void *info); void Init_Inline_Data(void); char **Find_Inline_Data(char *fct_name); void Emit_Inline_Data(char **p_inline); void Switch_Rec(int start, int stop, SwtInf swt[]); void Switch_Equal(SwtInf *c); int Switch_Cmp_Int(SwtInf *c1, SwtInf *c2); void Label_Printf(char *label, ...); void Inst_Printf(char *op, char *operands, ...); void Inst_Out(char *op, char *operands); void Char_Out(char c); void String_Out(char *s); void Int_Out(int d); void Parse_Arguments(int argc, char *argv[]); void Display_Help(void); #define Check_Arg(i, str) (strncmp(argv[i], str, strlen(argv[i])) == 0) /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { int n; Parse_Arguments(argc, argv); if (file_name_out == NULL) file_out = stdout; else if ((file_out = fopen(file_name_out, "wt")) == NULL) { fprintf(stderr, "cannot open output file %s\n", file_name_out); exit(1); } Init_Inline_Data(); BT_String_Init(&bt_string); BT_String_Init(&bt_code); /* only fill if Pre_Pass is asked */ BT_String_Init(&bt_long); Asm_Start(); if (!Parse_Ma_File(file_name_in, comment)) { fprintf(stderr, "Translation aborted\n"); exit(1); } Data_Start(initializer_fct); n = bt_string.nb_elem; if (n) { Dico_String_Start(n); BT_String_List(&bt_string, (BTStrLstFct) Dico_String); Dico_String_Stop(n); } n = bt_long.nb_elem; if (n) { Dico_Long_Start(n); BT_String_List(&bt_long, Invoke_Dico_Long); Dico_Long_Stop(n); } Data_Stop(initializer_fct); Asm_Stop(); if (file_out != stdout) fclose(file_out); exit(0); } /*-------------------------------------------------------------------------* * INVOKE_DICO_LONG * * * *-------------------------------------------------------------------------*/ void Invoke_Dico_Long(int unused_no, char *name, void *info) { LongInf *p = (LongInf *) info; Dico_Long(name, p->global, p->vtype, p->value); } /*-------------------------------------------------------------------------* * DECLARE_INITIALIZER * * * *-------------------------------------------------------------------------*/ void Declare_Initializer(char *init_fct) { /* init_fct: strdup done by the parser */ initializer_fct = init_fct; } /*-------------------------------------------------------------------------* * CALL_C * * * *-------------------------------------------------------------------------*/ void Call_C(char *fct_name, int fc, int nb_args, int nb_args_in_words, ArgInf arg[]) { unsigned i; /* unsigned is important for the loop */ int inc; int offset = 0; int no; char **p_inline; p_inline = Find_Inline_Data(fct_name); #if 0 /* to only inline a nth call (for debug) */ { static int nth_inline = 0; if (p_inline && ++nth_inline != 1) p_inline = NULL; } #endif if (ignore_fc) fc = 0; Call_C_Start(fct_name, fc, nb_args, nb_args_in_words, p_inline); if (!call_c_reverse_args) i = 0, inc = 1; else i = nb_args - 1, inc = -1; for (; i < (unsigned) nb_args; i += inc) { switch (arg[i].type) { case INTEGER: offset += Call_C_Arg_Int(offset, arg[i].t.int_val); break; case FLOAT: offset += Call_C_Arg_Double(offset, arg[i].t.dbl_val); break; case STRING: no = BT_String_Add(&bt_string, arg[i].t.str_val)->no; offset += Call_C_Arg_String(offset, no); break; case MEM: offset += Call_C_Arg_Mem_L(offset, arg[i].adr_of, arg[i].t.mem.name, arg[i].t.mem.index); break; case X_REG: offset += Call_C_Arg_Reg_X(offset, arg[i].adr_of, arg[i].t.index); break; case Y_REG: offset += Call_C_Arg_Reg_Y(offset, arg[i].adr_of, arg[i].t.index); break; case FL_ARRAY: offset += Call_C_Arg_Foreign_L(offset, arg[i].adr_of, arg[i].t.index); break; case FD_ARRAY: offset += Call_C_Arg_Foreign_D(offset, arg[i].adr_of, arg[i].t.index); break; default: /* for the compiler */ ; } } if (p_inline) { if (comment) Label_Printf("\t\t%s inlining %s", comment_prefix, fct_name); Emit_Inline_Data(p_inline); } else Call_C_Invoke(fct_name, fc, nb_args, nb_args_in_words); if (p_inline && comment) Label_Printf("\t\t%s code after inlining (Call_C_Stop)", comment_prefix); Call_C_Stop(fct_name, nb_args, p_inline); } /*-------------------------------------------------------------------------* * INIT_INLINE_DATA * * * *-------------------------------------------------------------------------*/ void Init_Inline_Data(void) { char **p, **q; if (inline_asm == 0) return; p = inline_asm_data; while(*p) { q = &INL_ACCESS_NEXT(p); for(p += 4; *p != INL_END_FUNC; p++) ; p++; *q = (char *) p; } } /*-------------------------------------------------------------------------* * FIND_INLINE_DATA * * * *-------------------------------------------------------------------------*/ char ** Find_Inline_Data(char *fct_name) { char **p; if (inline_asm) { p = inline_asm_data; while(*p && strcmp(*p, fct_name) != 0) p = (char **) INL_ACCESS_NEXT(p); if (*p && INL_ACCESS_LEVEL(p) <= inline_asm) return p; } return NULL; } /*-------------------------------------------------------------------------* * EMIT_INLINE_DATA * * * *-------------------------------------------------------------------------*/ void Emit_Inline_Data(char **p_inline) { char **p = p_inline; PlULong l; static int nb_inlined = 0; /* a global variable */ nb_inlined++; for(p += 4; *p != INL_END_FUNC; p++) { l = (PlULong) *p; if (l < 1024) /* label definition */ Label_Printf("%s%d_%d:", local_symb_prefix, nb_inlined, l); else { l = (PlULong) p[1]; if (l < 1024) Inst_Printf(p[0], "%s%d_%d", local_symb_prefix, nb_inlined, l); else Inst_Printf(p[0], "%s", p[1]); p++; } } } /*-------------------------------------------------------------------------* * SWITCH_RET * * * *-------------------------------------------------------------------------*/ void Switch_Ret(int nb_swt, SwtInf swt[]) { qsort((void *) swt, nb_swt, sizeof(SwtInf), (int (*)(const void *, const void *)) Switch_Cmp_Int); Switch_Rec(0, nb_swt - 1, swt); } /*-------------------------------------------------------------------------* * SWITCH_REC * * * *-------------------------------------------------------------------------*/ void Switch_Rec(int start, int stop, SwtInf swt[]) { int mid; char str[32]; switch (stop - start + 1) /* nb elements */ { case 1: Switch_Equal(swt + start); Pl_Fail(); break; case 2: Switch_Equal(swt + start); Switch_Equal(swt + stop); Pl_Fail(); break; case 3: Switch_Equal(swt + start); Switch_Equal(swt + start + 1); Switch_Equal(swt + stop); Pl_Fail(); break; default: mid = (start + stop) / 2; Switch_Equal(swt + mid); sprintf(str, "Lwork%d", work_label++); Jump_If_Greater(str); Switch_Rec(start, mid - 1, swt); Label(str); Switch_Rec(mid + 1, stop, swt); } } /*-------------------------------------------------------------------------* * SWITCH_EQUAL * * * *-------------------------------------------------------------------------*/ void Switch_Equal(SwtInf *c) { Cmp_Ret_And_Int(c->int_val); Jump_If_Equal(c->label); } /*-------------------------------------------------------------------------* * SWITCH_CMP_INT * * * *-------------------------------------------------------------------------*/ int Switch_Cmp_Int(SwtInf *c1, SwtInf *c2) { return c1->int_val - c2->int_val; } /*-------------------------------------------------------------------------* * DECL_LONG * * * *-------------------------------------------------------------------------*/ void Decl_Long(char *name, int global, VType vtype, PlLong value) { LongInf *p; /* name: strdup done by the parser */ p = (LongInf *) BT_String_Add(&bt_long, name)->info; p->global = global; p->vtype = vtype; p->value = value; } /*-------------------------------------------------------------------------* * DECL_CODE * * * *-------------------------------------------------------------------------*/ void /* called by Pre_Pass */ Decl_Code(char *name, int prolog, int global) { CodeInf *p; /* name: strdup done by the parser */ p = (CodeInf *) BT_String_Add(&bt_code, name)->info; p->prolog = prolog; p->global = global; } /*-------------------------------------------------------------------------* * IS_CODE_DEFINED * * * *-------------------------------------------------------------------------*/ int Is_Code_Defined(char *name) { return (BT_String_Lookup(&bt_code, name) != NULL); } /*-------------------------------------------------------------------------* * GET_LONG_INFOS * * * *-------------------------------------------------------------------------*/ int Get_Long_Infos(char *name, int *global, VType *vtype, int *value) { BTNode *b = BT_String_Lookup(&bt_long, name); LongInf *p; if (b == NULL) return 0; p = (LongInf *) b->info; *global = p->global; *vtype = p->vtype; *value = p->value; return 1; } /*-------------------------------------------------------------------------* * LABEL_PRINTF * * * *-------------------------------------------------------------------------*/ void Label_Printf(char *label, ...) { va_list arg_ptr; va_start(arg_ptr, label); vfprintf(file_out, label, arg_ptr); va_end(arg_ptr); fputc('\n', file_out); } /*-------------------------------------------------------------------------* * INST_PRINTF * * * *-------------------------------------------------------------------------*/ void Inst_Printf(char *op, char *operands, ...) { va_list arg_ptr; va_start(arg_ptr, operands); fprintf(file_out, "\t%s\t", op); vfprintf(file_out, operands, arg_ptr); va_end(arg_ptr); fputc('\n', file_out); } /*-------------------------------------------------------------------------* * INST_OUT * * * *-------------------------------------------------------------------------*/ void Inst_Out(char *op, char *operands) { fprintf(file_out, "\t%s\t%s\n", op, operands); } /*-------------------------------------------------------------------------* * CHAR_OUT * * * * Only needed by mappers inlining assembly code. * *-------------------------------------------------------------------------*/ void Char_Out(char c) { fprintf(file_out, "%c", c); } /*-------------------------------------------------------------------------* * STRING_OUT * * * * Only needed by mappers inlining assembly code. * *-------------------------------------------------------------------------*/ void String_Out(char *s) { fprintf(file_out, "%s", s); } /*-------------------------------------------------------------------------* * INT_OUT * * * * Only needed by mappers inlining assembly code. * *-------------------------------------------------------------------------*/ void Int_Out(int d) { fprintf(file_out, "%d", d); } /*-------------------------------------------------------------------------* * PARSE_ARGUMENTS * * * *-------------------------------------------------------------------------*/ void Parse_Arguments(int argc, char *argv[]) { static char str[1024]; int i; file_name_in = file_name_out = NULL; pic_code = 0; inline_asm = 0; ignore_fc = 0; comment = 0; for (i = 1; i < argc; i++) { if (*argv[i] == '-' && argv[i][1] != '\0') { if (Check_Arg(i, "-o") || Check_Arg(i, "--output")) { if (++i >= argc) { fprintf(stderr, "FILE missing after %s option\n", argv[i - 1]); exit(1); } file_name_out = argv[i]; continue; } if (Check_Arg(i, "--pic") || Check_Arg(i, "-fPIC")) { if (can_produce_pic_code) pic_code = 1; else fprintf(stderr, "ignored option %s - cannot produce PIC code for this architecture\n", argv[i]); continue; } if (Check_Arg(i, "--inline-asm")) { inline_asm = 1; continue; } if (Check_Arg(i, "--full-inline-asm")) { inline_asm = 2; continue; } if (Check_Arg(i, "--ignore-fast")) { ignore_fc = 1; continue; } if (Check_Arg(i, "--comment")) { comment = 1; continue; } if (Check_Arg(i, "--version")) { Display_Copying("Mini-Assembly to Assembly Compiler"); exit(0); } if (Check_Arg(i, "-h") || Check_Arg(i, "--help")) { Display_Help(); exit(0); } fprintf(stderr, "unknown option %s - try ma2asm --help\n", argv[i]); exit(1); } if (file_name_in != NULL) { fprintf(stderr, "input file already specified (%s)\n", file_name_in); exit(1); } file_name_in = argv[i]; } if (file_name_in != NULL && strcmp(file_name_in, "-") == 0) file_name_in = NULL; if (file_name_out == NULL && file_name_in != NULL) { strcpy(str, file_name_in); i = strlen(str); if (strcmp(str + i - 3, ".ma") == 0) strcpy(str + i - 3, DEFAULT_OUTPUT_SUFFIX); else strcpy(str + i, DEFAULT_OUTPUT_SUFFIX); file_name_out = str; } if (file_name_out != NULL && strcmp(file_name_out, "-") == 0) file_name_out = NULL; } /*-------------------------------------------------------------------------* * DISPLAY_HELP * * * *-------------------------------------------------------------------------*/ void Display_Help(void) #define L(msg) fprintf(stderr, "%s\n", msg) { L("Usage: ma2asm [option...] file"); L(""); L("Options:"); L(" -o FILE, --output FILE set output file name"); L(" --pic produce position independent code (PIC)"); L(" --inline-asm inline some C calls as asm instructions"); L(" --full-inline-asm inline most C calls as asm instructions"); L(" --ignore-fast ignore fast call (FC) declarations"); L(" --comment include comments in the output file"); L(" -h, --help print this help and exit"); L(" --version print version number and exit"); L(""); L("'-' can be given as <file> for the standard input/output"); L(""); L("Report bugs to bug-prolog@gnu.org."); } #undef L ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/x86_64_any.c���������������������������������������������������������������0000644�0001750�0001750�00000116061�13021324543�015144� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : x86_64_any.c * * Descr.: translation file for Linux on AMD x86-64 * * Author: Gwenole Beauchesne, Ozaki Kiichi and Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz and Gwenole Beauchesne * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <limits.h> /* For M_x86_64_linux/solaris: an important point is that C stack must be * aligned on 16 bytes else some problems occurs with double. * If this is not done and if the called function performs a movaps %xmm0,xx * an error will occur. * Just before calling a function %rsp is 16bytes aligned, %rsp = 0x...0 * (4 low bits = 0). The callq instruction pushes the return address, so at * the entry of a function, %rsp is 0x...8. Gcc then adjusts (via subq) * %rsp to be 0x...0 before calling a function. We mimic the same modifying * Call_Compiled to force %rsp to be 0x...0 when arriving in a Prolog code. * So a Prolog code can call C functions safely. * When a Prolog code finishes it returns into C inside Call_Prolog_Success * or Call_Prolog_Fail. In both functions we re-adjust the stack (gcc thinks * %rsp = 0x...8 while it is 0x...0): after the gcc adjustment code we * force %rsp to be 0x...0. * For MA c_code (MA code called by a C function), we have to reserve enough * space in the stack to pass args to C functions. We receive %rsp = 0x...c * In addition we have to push 1 register (%rbx) * Thus 0x...8 - 8 = 0x...0 : OK ! We have to sub to %rsp the space for * MAX_C_ARGS_IN_C_CODE*8 (this is OK if MAX_C_ARGS_IN_C_CODE is a multiple * of 2). So we have to reserve: MAX_C_ARGS_IN_C_CODE * 8. * * Mac OS X Yosemite (14.0.0) using clang: similar problem when using an * xmmN regs and movdqa instruction (for integ operations on longs = 64bits). * It appeared in the chkma utility. Due to a global variable misaligned. * defined initially with .comm _ma_array,40000,3 * problem was fixed using .comm _ma_array,40000,4 */ /*---------------------------------* * Constants * *---------------------------------*/ #ifdef M_x86_64_darwin #define STRING_PREFIX "L_.str" #define DOUBLE_PREFIX "LCPI" #define UN "_" #define CONT_LABEL_FMT "Ltmp%d" #else #define STRING_PREFIX ".LC" #define DOUBLE_PREFIX ".LCD" #define UN #define CONT_LABEL_FMT ".Lcont%d" #endif #define MAX_C_ARGS_IN_C_CODE 32 /* must be a multiple of 2 */ #define RESERVED_STACK_SPACE MAX_C_ARGS_IN_C_CODE * 8 #define MAX_DOUBLES_IN_PRED 2048 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static double dbl_tbl[MAX_DOUBLES_IN_PRED]; static int nb_dbl = 0; static int dbl_lc_no = 0; char asm_reg_e[20]; char asm_reg_b[20]; char asm_reg_cp[20]; int w_label = 0; #ifdef _WIN32 #define MAX_PR_ARGS 4 static int pr_arg_no; static const char *gpr_arg[MAX_PR_ARGS] = { "%rcx", "%rdx", "%r8", "%r9" }; static const char *fpr_arg[MAX_PR_ARGS] = { "%xmm0", "%xmm1", "%xmm2", "%xmm3" }; #else #define MAX_GPR_ARGS 6 static int gpr_arg_no; static const char *gpr_arg[MAX_GPR_ARGS] = { "%rdi", "%rsi", "%rdx", "%rcx", "%r8", "%r9" }; #define MAX_FPR_ARGS 8 static int fpr_arg_no; static const char *fpr_arg[MAX_FPR_ARGS] = { "%xmm0", "%xmm1", "%xmm2", "%xmm3", "%xmm4", "%xmm5", "%xmm6", "%xmm7" }; #endif /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 1; char *comment_prefix = "#"; #ifdef M_x86_64_darwin char *local_symb_prefix = "L"; #else char *local_symb_prefix = ".L"; #endif int strings_need_null = 0; int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static char *Off_Reg_Bank(int offset); #define LITTLE_INT(X) ((X) >= INT_MIN && (X) <= INT_MAX) /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { /* M_x86_64_darwin needs a reg for pl_reg_bank (default is r12 see engine1.c) * so NO_MACHINE_REG_FOR_REG_BANK is never set (see machine.h). Else this * error occurs '32-bit absolute addressing is not supported for x86-64' */ #ifdef NO_MACHINE_REG_FOR_REG_BANK #define ASM_REG_BANK "pl_reg_bank" #elif defined(MAP_REG_BANK) #define ASM_REG_BANK "%" MAP_REG_BANK #else #define ASM_REG_BANK "%r12" #endif #ifdef MAP_REG_E sprintf(asm_reg_e, "%%%s", MAP_REG_E); #else strcpy(asm_reg_e, "%rbx"); #endif #ifdef MAP_REG_B sprintf(asm_reg_b, "%%%s", MAP_REG_B); #else strcpy(asm_reg_b, Off_Reg_Bank(MAP_OFFSET_B)); #endif #ifdef MAP_REG_CP sprintf(asm_reg_cp, "%%%s", MAP_REG_CP); #else strcpy(asm_reg_cp, Off_Reg_Bank(MAP_OFFSET_CP)); #endif #if defined(M_x86_64_darwin) || defined(M_x86_64_bsd) pic_code = 1; /* NB: on darwin and BSD everything is PIC code */ #elif defined(_WIN32) pic_code = 0; /* NB: on MinGW nothing is needed for PIC code */ #endif #ifdef M_x86_64_darwin Inst_Printf(".section", "__TEXT,__text,regular,pure_instructions"); Inst_Printf(".align", "4, 0x90"); #else Label_Printf(".text"); #endif Label("fail"); Pl_Fail(); } /*-------------------------------------------------------------------------* * OFF_REG_BANK * * * *-------------------------------------------------------------------------*/ static char * Off_Reg_Bank(int offset) { static char str[20]; #ifdef NO_MACHINE_REG_FOR_REG_BANK sprintf(str, ASM_REG_BANK "+%d", offset); #else sprintf(str, "%d(%s)", offset, ASM_REG_BANK); #endif return str; } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { #ifdef __ELF__ Inst_Printf(".section", ".note.GNU-stack,\"\",@progbits"); #endif } /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { int i; int x = dbl_lc_no - nb_dbl; for (i = 0; i < nb_dbl; i++) { union { double d; unsigned int w[2]; } dbl; dbl.d = dbl_tbl[i]; Label_Printf("%s%d:", DOUBLE_PREFIX, x++); Inst_Printf(".long", "%d", dbl.w[0]); Inst_Printf(".long", "%d", dbl.w[1]); } nb_dbl = 0; Label_Printf(""); #ifdef M_x86_64_darwin Inst_Printf(".align", "4, 0x90"); #else #if 1 /* old code */ Inst_Printf(".p2align", "4,,15"); #else Inst_Printf(".align", "16"); #endif #if defined(M_x86_64_linux) || defined(M_x86_64_bsd) || defined(M_x86_64_sco) Inst_Printf(".type", "%s,@function", label); #endif #endif if (global) Inst_Printf(".globl", UN "%s", label); Label(label); if (!prolog) { /* Save callee-saved registers. However, don't explicitly preserve %r12-%r15 since they are already handled as global -ffixed ones. */ Inst_Printf("pushq", "%%rbx"); Inst_Printf("subq", "$%d,%%rsp", RESERVED_STACK_SPACE); } } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf(""); Label_Printf(UN "%s:", label); } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { #ifndef MAP_REG_E Inst_Printf("movq", "%s,%s", Off_Reg_Bank(MAP_OFFSET_E), asm_reg_e); #endif } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { #ifndef M_x86_64_darwin if (pic_code) Inst_Printf("jmp", UN "%s@PLT", label); else #endif Inst_Printf("jmp", UN "%s", label); } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { if (pic_code) { Inst_Printf("leaq", CONT_LABEL_FMT "(%%rip),%%r10", w_label); Inst_Printf("movq", "%%r10,%s", asm_reg_cp); } else { Inst_Printf("movq", "$" CONT_LABEL_FMT ",%s", w_label, asm_reg_cp); } } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf(CONT_LABEL_FMT ":", w_label++); } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Prep_CP(); Pl_Jump(label); Here_CP(); } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Inst_Printf("jmp", "*-8(%s)", asm_reg_b); #else Inst_Printf("movq", "%s,%%rdx", asm_reg_b); Inst_Printf("jmp", "*-8(%%rdx)"); #endif } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { #ifndef MAP_REG_CP Inst_Printf("jmp", "*%s", asm_reg_cp); #else Inst_Printf("jmp", "%s", asm_reg_cp); #endif } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { #ifndef M_x86_64_darwin if (pic_code) Inst_Printf("jmp", UN "%s@PLT", label); else #endif Inst_Printf("jmp", UN "%s", label); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Inst_Printf("movq", "%s,%%rdx", Off_Reg_Bank(index * 8)); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { Inst_Printf("movq", "%d(%s),%%rdx", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Inst_Printf("movq", "%%rdx,%s", Off_Reg_Bank(index * 8)); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { Inst_Printf("movq", "%%rdx,%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { #ifdef _WIN32 pr_arg_no = 0; #else gpr_arg_no = 0; fpr_arg_no = 0; #endif } #ifdef _WIN32 #define BEFORE_ARG \ { \ char r[10], *r_aux; \ int r_eq_r_aux = 0; \ \ if (pr_arg_no < MAX_PR_ARGS) \ { \ strcpy(r, gpr_arg[pr_arg_no++]); \ r_aux = r; \ r_eq_r_aux = 1; \ } \ else \ { \ int nwords = offset; \ \ sprintf(r, "%d(%%rsp)", nwords * 8); \ r_aux = "%rax"; \ } #define BEFORE_FPR_ARG \ { \ char r[10], *r_aux; \ int r_eq_r_aux = 0; \ \ if (pr_arg_no < MAX_PR_ARGS) \ { \ strcpy(r, fpr_arg[pr_arg_no++]); \ r_aux = r; \ r_eq_r_aux = 1; \ } \ else \ { \ int nwords = offset; \ \ sprintf(r, "%d(%%rsp)", nwords * 8); \ r_aux = "%xmm8"; \ } #else #define BEFORE_ARG \ { \ char r[10], *r_aux; \ int r_eq_r_aux = 0; \ \ if (gpr_arg_no < MAX_GPR_ARGS) \ { \ strcpy(r, gpr_arg[gpr_arg_no++]); \ r_aux = r; \ r_eq_r_aux = 1; \ } \ else \ { \ int nwords = offset - gpr_arg_no - fpr_arg_no; \ \ sprintf(r, "%d(%%rsp)", nwords * 8); \ r_aux = "%rax"; \ } #define BEFORE_FPR_ARG \ { \ char r[10], *r_aux; \ int r_eq_r_aux = 0; \ \ if (fpr_arg_no < MAX_FPR_ARGS) \ { \ strcpy(r, fpr_arg[fpr_arg_no++]); \ r_aux = r; \ r_eq_r_aux = 1; \ } \ else \ { \ int nwords = offset - gpr_arg_no - fpr_arg_no; \ \ sprintf(r, "%d(%%rsp)", nwords * 8); \ r_aux = "%xmm8"; \ } #endif #define AFTER_ARG \ } #define AFTER_FPR_ARG \ } /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { BEFORE_ARG; if (LITTLE_INT(int_val)) Inst_Printf("movq", "$%" PL_FMT_d ",%s", int_val, r); else { Inst_Printf("movabsq", "$%" PL_FMT_d ",%s", int_val, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); } AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { BEFORE_FPR_ARG; dbl_tbl[nb_dbl++] = dbl_val; Inst_Printf("movsd", "%s%d(%%rip),%s", DOUBLE_PREFIX, dbl_lc_no++, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); AFTER_FPR_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { BEFORE_ARG; if (pic_code) { Inst_Printf("leaq", "%s%d(%%rip),%s", STRING_PREFIX, str_no, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); } else { Inst_Printf("movq", "$%s%d,%s", STRING_PREFIX, str_no, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); } AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { BEFORE_ARG; if (pic_code) { Inst_Printf("movq", UN "%s@GOTPCREL(%%rip),%s", name, r_aux); if (adr_of) { if (index != 0) Inst_Printf("addq", "$%d,%s", index * 8, r_aux); } else Inst_Printf("movq", "%d(%s),%s", index * 8, r_aux, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); } else { if (adr_of) Inst_Printf("movq", "$" "%s+%d,%s", name, index * 8, r); else { Inst_Printf("movq", "%s+%d(%%rip),%s", name, index * 8, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); } } AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) { if (!r_eq_r_aux && index == 0) { #ifdef NO_MACHINE_REG_FOR_REG_BANK Inst_Printf("movq", "$%s,%s", ASM_REG_BANK, r); #else Inst_Printf("movq", "%s,%s", ASM_REG_BANK, r); #endif goto finish; } Inst_Printf("leaq", "%s,%s", Off_Reg_Bank(index * 8), r_aux); } else Inst_Printf("movq", "%s,%s", Off_Reg_Bank(index * 8), r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); finish: ; /* gcc3 does not like use of label at end of compound statement */ AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Inst_Printf("leaq", "%d(%s),%s", Y_OFFSET(index), asm_reg_e, r_aux); else Inst_Printf("movq", "%d(%s),%s", Y_OFFSET(index), asm_reg_e, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { BEFORE_ARG; if (pic_code) { Inst_Printf("movq", UN "pl_foreign_long@GOTPCREL(%%rip), %s", r_aux); if (adr_of) { if (index != 0) Inst_Printf("addq", "$%d, %s", index * 8, r_aux); } else Inst_Printf("movq", "%d(%s), %s", index * 8, r_aux, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s, %s", r_aux, r); } else { if (adr_of) Inst_Printf("movq", "$" UN "pl_foreign_long+%d, %s", index * 8, r); else { Inst_Printf("movq", UN "pl_foreign_long+%d(%%rip),%s", index * 8, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s, %s", r_aux, r); } } AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { if (adr_of) { BEFORE_ARG; if (pic_code) { Inst_Printf("movq", UN "pl_foreign_double@GOTPCREL(%%rip), %s", r_aux); if (index != 0) Inst_Printf("addq", "$%d, %s", index * 8, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s, %s", r_aux, r); } else { Inst_Printf("movq", "$" UN "pl_foreign_double+%d, %s", index * 8, r_aux); if (!r_eq_r_aux) Inst_Printf("movq", "%s,%s", r_aux, r); } AFTER_ARG; return 1; } BEFORE_FPR_ARG; if (pic_code) { Inst_Printf("movq", UN "pl_foreign_double@GOTPCREL(%%rip),%%r10"); Inst_Printf("movsd", "%d(%%r10), %s", index * 8, r_aux); } else { Inst_Printf("movsd", UN "pl_foreign_double+%d(%%rip),%s", index * 8, r_aux); } if (!r_eq_r_aux) Inst_Printf("movsd", "%s, %s", r_aux, r); AFTER_FPR_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { #ifndef M_x86_64_darwin if (pic_code) Inst_Printf("call", UN "%s@PLT", fct_name); else #endif Inst_Printf("call", UN "%s", fct_name); } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { #ifndef MAP_REG_E if (p_inline && INL_ACCESS_INFO(p_inline)) reload_e = 1; #endif } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Inst_Printf("jmp", "*%%rax"); } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Inst_Printf("test", "%%rax,%%rax"); Inst_Printf("je", UN "fail"); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { if (pic_code) { Inst_Printf("movq", UN "%s@GOTPCREL(%%rip)," "%%r10", name); Inst_Printf("movq", "%%rax," "%d(%%r10)", index * 8); } else { Inst_Printf("movq", "%%rax," "%s+%d(%%rip)", name, index * 8); } } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* similar to Move_To_Reg_X */ Inst_Printf("movq", "%%rax,%s", Off_Reg_Bank(index * 8)); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* similar to Move_To_Reg_Y */ Inst_Printf("movq", "%%rax,%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { if (pic_code) { Inst_Printf("movq", UN "pl_foreign_long@GOTPCREL(%%rip)," "%%r10"); Inst_Printf("movq", "%%rax," "%d(%%r10)", index * 8); } else { Inst_Printf("movq", "%%rax," UN "pl_foreign_long+%d(%%rip)", index * 8); } } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { if (pic_code) { Inst_Printf("movq", UN "pl_foreign_double@GOTPCREL(%%rip)," "%%r10"); Inst_Printf("movsd", "%%xmm0," "%d(%%r10)", index * 8); } else { Inst_Printf("movsd", "%%xmm0," UN "pl_foreign_double+%d(%%rip)", index * 8); } } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { if (int_val == 0) Inst_Printf("testq", "%%rax,%%rax"); else if (LITTLE_INT(int_val)) Inst_Printf("cmpq", "$%" PL_FMT_d ",%%rax", int_val); else { /* %rdx is second integral return value. At this stage, it is bound to be dead since we only deal with primitive object types. */ Inst_Printf("movabsq", "$%" PL_FMT_d ",%%rdx", int_val); Inst_Printf("cmpq", "%%rdx,%%rax", int_val); } } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Inst_Printf("je", UN "%s", label); } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { Inst_Printf("jg", UN "%s", label); } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Inst_Printf("addq", "$%d,%%rsp", RESERVED_STACK_SPACE); Inst_Printf("popq", "%%rbx"); Inst_Printf("ret", ""); } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { #ifdef M_x86_64_darwin Inst_Printf(".section", UN "_TEXT,__cstring,cstring_literals"); #else Label_Printf(".section\t.rodata"); #endif } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Label_Printf("%s%d:", STRING_PREFIX, str_no); #ifdef M_x86_64_darwin Inst_Printf(".asciz", "%s", asciiz); #else Inst_Printf(".string", "%s", asciiz); #endif } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { #ifdef M_x86_64_darwin Inst_Printf(".section", "__DATA,__data"); Inst_Printf(".align", "3"); #else Label_Printf(".data"); Inst_Printf(".align", "16"); #endif } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { PlLong size_bytes; switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: size_bytes = value * 8; #ifdef M_x86_64_darwin if (!global) Label_Printf(".zerofill __DATA,__bss," UN "%s,%" PL_FMT_d ",4", name, size_bytes); else Inst_Printf(".comm", UN "%s,%" PL_FMT_d ",4", name, size_bytes); #else #if defined(M_x86_64_linux) || defined(M_x86_64_sco) || \ defined(M_x86_64_solaris) || defined(M_x86_64_bsd) if (!global) Inst_Printf(".local", UN "%s", name); #else if (!global) Inst_Printf(".lcomm", UN "%s,%" PL_FMT_d, name, size_bytes); else #endif #if 1 /* work for all */ Inst_Printf(".comm", UN "%s,%" PL_FMT_d ",8", name, size_bytes); #else /* this does not work under MinGW - not used for the moment */ if (value < 4) Inst_Printf(".comm", UN "%s,%" PL_FMT_d ",8", name, size_bytes); else Inst_Printf(".comm", UN "%s,%" PL_FMT_d ",32", name, size_bytes); #endif #endif break; case INITIAL_VALUE: if (global) Inst_Printf(".globl", UN "%s", name); #ifdef M_x86_64_darwin Inst_Printf(".align", "3"); #else Inst_Printf(".align", "8"); #endif #if !(defined(M_x86_64_darwin) || defined(_WIN32)) Inst_Printf(".size", UN "%s,8", name); #endif Label_Printf(UN "%s:", name); Inst_Printf(".quad", "%" PL_FMT_d, value); break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { #ifdef M_x86_64_darwin Label_Printf("\n\n.subsections_via_symbols"); #endif } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { if (initializer_fct == NULL) return; #ifdef _MSC_VER Inst_Printf(".section", ".GPLC$m"); #elif defined(__CYGWIN__) || defined(_WIN32) Inst_Printf(".section", ".ctors,\"aw\""); #elif defined(M_x86_64_darwin) Inst_Printf(".section", "__DATA,__mod_init_func,mod_init_funcs"); #else Inst_Printf(".section", ".ctors,\"aw\",@progbits"); #endif #ifdef M_x86_64_darwin Inst_Printf(".align", "3"); #else Inst_Printf(".align", "8"); #endif Inst_Printf(".quad", UN "%s", initializer_fct); } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/mips_irix.c����������������������������������������������������������������0000644�0001750�0001750�00000110153�13021324543�015336� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : mips_irix.c * * Descr.: translation file for IRIX on MIPS * * Author: Alexander Diemand, Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <stdio.h> #include <stdarg.h> #include <string.h> /*---------------------------------* * Constants * *---------------------------------*/ #define STRING_PREFIX ".LC" #define MAX_C_ARGS_IN_C_CODE 32 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ char asm_reg_bank[20]; char asm_reg_e[20]; char asm_reg_b[20]; char asm_reg_cp[20]; int w_label = 0; static char dbl_arg_buffer[8192] = "\0"; /* a temp buffer for the double arguments */ char act_routine[512] = "\0"; /* remembers the actual routine we are building */ int inPrologCode = 0; /* whether we are currently compiling a prolog code */ /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 0; char *comment_prefix = "#"; char *local_symb_prefix = ".L"; int strings_need_null = 1; int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * INLINED CODE * * * *-------------------------------------------------------------------------*/ /* all %s will be replaced with the function's name * all %d will be replaced with the current nb_inlines */ static long nb_inlines = 0; static char *def_inlines[] = { /* name code */ 0, 0 /* end of list */ }; /*-------------------------------------------------------------------------* * MAKE_INLINE * * * *-------------------------------------------------------------------------*/ /* when it finds a function to inline it will do so immediatly and return 1 * else it fails and returns 0 */ static int make_inline(char *fct_name, int nb_args) { char *fp; int counter; return 0; /* not yet */ /* user can set an environment variable to control this */ if (!getenv("GPROLOG_ASM_INLINE")) return 0; counter = 0; while (def_inlines[counter]) { if (strcmp(fct_name, def_inlines[counter]) == 0) { /* found code to inline, emit */ fp = def_inlines[++counter]; while (*fp != '\0') { if (*fp == '%' && *(fp + 1) == 's') { String_Out(fct_name); fp++; } else if (*fp == '%' && *(fp + 1) == 'd') { Int_Out(nb_inlines); fp++; } else { Char_Out(*fp); } fp++; } nb_inlines++; return 1; } counter++; } return 0; } /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { #ifdef MAP_REG_BANK sprintf(asm_reg_bank, "%s", MAP_REG_BANK); #else strcpy(asm_reg_bank, "$16"); #endif #ifdef MAP_REG_E sprintf(asm_reg_e, "%s", MAP_REG_E); #else /* strcpy(asm_reg_e,"$21"); */ sprintf(asm_reg_e, "%d(%s)", MAP_OFFSET_E, asm_reg_bank); #endif #ifdef MAP_REG_B sprintf(asm_reg_b, "%s", MAP_REG_B); #else /* sprintf(asm_reg_b,"$18"); */ sprintf(asm_reg_b, "%d(%s)", MAP_OFFSET_B, asm_reg_bank); #endif #ifdef MAP_REG_CP sprintf(asm_reg_cp, "%s", MAP_REG_CP); #else /* sprintf(asm_reg_cp,"$20"); */ sprintf(asm_reg_cp, "%d(%s)", MAP_OFFSET_CP, asm_reg_bank); #endif Inst_Printf(".option", "pic2"); /* gcc uses this */ Inst_Printf("#.set", "noat"); Inst_Printf("#.set", "noreorder"); /* let the assembler reorder instructions */ Inst_Printf("# asm_reg_bank ", asm_reg_bank); Inst_Printf("# asm_reg_e ", asm_reg_e); Inst_Printf("# asm_reg_b ", asm_reg_b); Inst_Printf("# asm_reg_cp ", asm_reg_cp); Label_Printf("\t.section\t.text"); } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { /* we are printing the fixed doubles at the end of the file, * they will appear in the data section */ if (dbl_arg_buffer[0] != '\0') { Label_Printf(".section\t.rodata"); Label_Printf(dbl_arg_buffer); dbl_arg_buffer[0] = '\0'; } } /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { if (act_routine[0] != '\0') Code_Stop(); /* we first have to close the previous code */ Inst_Printf(".text", ""); Inst_Printf(".align", "2"); Inst_Printf(".ent", "%s", label); if (global) Inst_Printf(".globl", "%s", label); Label(label); /* remember this label */ strcpy(act_routine, label); if (prolog) { /* prolog code does not need any stack space */ inPrologCode = 1; Inst_Printf(".frame", "$sp,0,$31"); Inst_Printf(".mask", "0x00000000,0"); Inst_Printf(".fmask", "0x00000000,0"); } else { /* for c code we need to save some registers */ inPrologCode = 0; /* */ Inst_Printf(".frame", "$sp,%d,$31", MAX_C_ARGS_IN_C_CODE * 8 + 16); Inst_Printf(".mask", "0x10000000,-16"); Inst_Printf(".fmask", "0x00000000,0"); Inst_Printf("subu", "$sp,$sp,%d", MAX_C_ARGS_IN_C_CODE * 8 + 16); Inst_Printf("sd", "$gp,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8 + 8); Inst_Printf("sd", "$31,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8 + 0); } } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { Inst_Printf(".end", "%s", act_routine); act_routine[0] = '\0'; } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf("\n%s:", label); } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { Inst_Printf("la", "$25,%s", label); Inst_Printf("j", "$25"); } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { #ifdef MAP_REG_CP Inst_Printf("la", "%s,.Lcont%d", asm_reg_cp, w_label); /* CP = .Lcont%d */ #else Inst_Printf("la", "$13,.Lcont%d", w_label); Inst_Printf("sw", "$13,%s", asm_reg_cp); /* CP = .Lcont%d */ #endif } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf(".Lcont%d:", w_label++); } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Prep_CP(); Pl_Jump(label); Here_CP(); } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Inst_Printf("lw", "$25,-4(%s)", asm_reg_b); #else Inst_Printf("lw", "$13,%s", asm_reg_b); Inst_Printf("lw", "$25,-4($13)"); #endif Inst_Printf("j", "$25"); } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { Inst_Printf(".align", "3"); Inst_Printf("# nop", ""); /* I don't really know why, but it helps ;-) */ #ifdef MAP_REG_CP Inst_Printf("move", "$25,%s", asm_reg_cp); #else Inst_Printf("lw", "$25,%s", asm_reg_cp); #endif Inst_Printf("j", "$25"); } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { Inst_Printf("la", "$25,%s", label); Inst_Printf("j", "$25"); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Inst_Printf("lw", "$24,%d(%s)", 4 * index, asm_reg_bank); /* asm_reg_bank */ } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { #ifdef MAP_REG_E Inst_Printf("lw", "$24,%d(%s)", Y_OFFSET(index), asm_reg_e); #else Inst_Printf("lw", "$13,%s", asm_reg_e); Inst_Printf("lw", "$24,%d($13)", Y_OFFSET(index)); #endif } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Inst_Printf("sw", "$24,%d(%s)", 4 * index, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { #ifdef MAP_REG_E Inst_Printf("sw", "$24,%d(%s)", Y_OFFSET(index), asm_reg_e); #else Inst_Printf("lw", "$13,%s", asm_reg_e); Inst_Printf("sw", "$24,%d($13)", Y_OFFSET(index)); #endif } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { } /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { switch (offset) { case 0: Inst_Printf("li", "$4,%d", int_val); break; case 1: Inst_Printf("li", "$5,%d", int_val); break; case 2: Inst_Printf("li", "$6,%d", int_val); break; case 3: Inst_Printf("li", "$7,%d", int_val); break; case 4: Inst_Printf("li", "$8,%d", int_val); break; case 5: Inst_Printf("li", "$9,%d", int_val); break; case 6: Inst_Printf("li", "$10,%d", int_val); break; case 7: Inst_Printf("li", "$11,%d", int_val); break; default: Inst_Printf("li", "$24,%d", int_val); Inst_Printf("sw", "$24,%d($sp)", (offset - 8) * 8 + 4); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { char buf[1024]; sprintf(buf, "\t.align 3\n.LD%d:\n\t.double %1.20e\n", w_label++, dbl_val); strcat(dbl_arg_buffer, buf); Inst_Printf("la", "$24,.LD%d", (w_label - 1)); switch (offset) { case 0: Inst_Printf("l.d", "$f12,($24)"); break; case 1: Inst_Printf("l.d", "$f13,($24)"); break; case 2: Inst_Printf("l.d", "$f14,($24)"); break; case 3: Inst_Printf("l.d", "$f15,($24)"); break; case 4: Inst_Printf("l.d", "$f16,($24)"); break; case 5: Inst_Printf("l.d", "$f17,($24)"); break; case 6: Inst_Printf("l.d", "$f18,($24)"); break; case 7: Inst_Printf("l.d", "$f19,($24)"); break; default: Inst_Printf("l.d", "$f1,($24)"); Inst_Printf("s.d", "$f1,%d($sp)", (offset - 8) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { switch (offset) { case 0: Inst_Printf("la", "$4,%s%d", STRING_PREFIX, str_no); break; case 1: Inst_Printf("la", "$5,%s%d", STRING_PREFIX, str_no); break; case 2: Inst_Printf("la", "$6,%s%d", STRING_PREFIX, str_no); break; case 3: Inst_Printf("la", "$7,%s%d", STRING_PREFIX, str_no); break; case 4: Inst_Printf("la", "$8,%s%d", STRING_PREFIX, str_no); break; case 5: Inst_Printf("la", "$9,%s%d", STRING_PREFIX, str_no); break; case 6: Inst_Printf("la", "$10,%s%d", STRING_PREFIX, str_no); break; case 7: Inst_Printf("la", "$11,%s%d", STRING_PREFIX, str_no); break; default: Inst_Printf("la", "$24,%s%d", STRING_PREFIX, str_no); Inst_Printf("sw", "$24,%d($sp)", (offset - 8) * 8 + 4); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$4"); break; case 1: sprintf(dest, "%s", "$5"); break; case 2: sprintf(dest, "%s", "$6"); break; case 3: sprintf(dest, "%s", "$7"); break; case 4: sprintf(dest, "%s", "$8"); break; case 5: sprintf(dest, "%s", "$9"); break; case 6: sprintf(dest, "%s", "$10"); break; case 7: sprintf(dest, "%s", "$11"); break; default: sprintf(dest, "%s", "$24"); break; } if (!adr_of) { Inst_Printf("la", "$25,%s", name); Inst_Printf("lw", "%s,%d($25)", dest, index * 4); } else { Inst_Printf("la", "%s,%s+%d", dest, name, index * 4); } if (offset > 7) { Inst_Printf("sw", "%s,%d($sp)", dest, (offset - 8) * 8 + 4); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$4"); break; case 1: sprintf(dest, "%s", "$5"); break; case 2: sprintf(dest, "%s", "$6"); break; case 3: sprintf(dest, "%s", "$7"); break; case 4: sprintf(dest, "%s", "$8"); break; case 5: sprintf(dest, "%s", "$9"); break; case 6: sprintf(dest, "%s", "$10"); break; case 7: sprintf(dest, "%s", "$11"); break; default: sprintf(dest, "%s", "$24"); break; } if (!adr_of) { Inst_Printf("lw", "%s,%d(%s)", dest, index * 4, asm_reg_bank); } else { if (index == 0) { Inst_Printf("move", "%s,%s", dest, asm_reg_bank); } else { Inst_Printf("la", "%s,%d(%s)", dest, index * 4, asm_reg_bank); } } if (offset > 7) { Inst_Printf("sw", "%s,%d($sp)", dest, (offset - 8) * 8 + 4); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$4"); break; case 1: sprintf(dest, "%s", "$5"); break; case 2: sprintf(dest, "%s", "$6"); break; case 3: sprintf(dest, "%s", "$7"); break; case 4: sprintf(dest, "%s", "$8"); break; case 5: sprintf(dest, "%s", "$9"); break; case 6: sprintf(dest, "%s", "$10"); break; case 7: sprintf(dest, "%s", "$11"); break; default: sprintf(dest, "%s", "$24"); break; } if (!adr_of) { #ifdef MAP_REG_E Inst_Printf("lw", "%s,%d(%s)", dest, Y_OFFSET(index), asm_reg_e); #else Inst_Printf("lw", "$12,%s", asm_reg_e); Inst_Printf("lw", "%s,%d($12)", dest, Y_OFFSET(index)); #endif } else { #ifdef MAP_REG_E Inst_Printf("la", "%s,%d(%s)", dest, Y_OFFSET(index), asm_reg_e); #else Inst_Printf("lw", "$12,%s", asm_reg_e); Inst_Printf("la", "%s,%d($12)", dest, Y_OFFSET(index)); #endif } if (offset > 7) { Inst_Printf("sw", "%s,%d($sp)", dest, (offset - 8) * 8 + 4); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$4"); break; case 1: sprintf(dest, "%s", "$5"); break; case 2: sprintf(dest, "%s", "$6"); break; case 3: sprintf(dest, "%s", "$7"); break; case 4: sprintf(dest, "%s", "$8"); break; case 5: sprintf(dest, "%s", "$9"); break; case 6: sprintf(dest, "%s", "$10"); break; case 7: sprintf(dest, "%s", "$11"); break; default: sprintf(dest, "%s", "$24"); break; } Inst_Printf("la", "$2,pl_foreign_long"); if (!adr_of) { Inst_Printf("lw", "%s,%d($2)", dest, index * 4); } else { Inst_Printf("la", "%s,%d($2)", dest, index * 4); } if (offset > 7) { Inst_Printf("sw", "%s,%d($sp)", dest, (offset - 8) * 8 + 4); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { char dest[8]; if (adr_of) { switch (offset) { case 0: sprintf(dest, "%s", "$4"); break; case 1: sprintf(dest, "%s", "$5"); break; case 2: sprintf(dest, "%s", "$6"); break; case 3: sprintf(dest, "%s", "$7"); break; case 4: sprintf(dest, "%s", "$8"); break; case 5: sprintf(dest, "%s", "$9"); break; case 6: sprintf(dest, "%s", "$10"); break; case 7: sprintf(dest, "%s", "$11"); break; default: sprintf(dest, "%s", "$24"); break; } Inst_Printf("la", "%s,pl_foreign_double", dest); Inst_Printf("addu", "%s,%s,%d", dest, dest, index * 8); if (offset > 7) { Inst_Printf("sw", "%s,%d($sp)", dest, (offset - 8) * 8); } return 1; } else { switch (offset) { case 0: sprintf(dest, "%s", "$f12"); break; case 1: sprintf(dest, "%s", "$f13"); break; case 2: sprintf(dest, "%s", "$f14"); break; case 3: sprintf(dest, "%s", "$f15"); break; case 4: sprintf(dest, "%s", "$f16"); break; case 5: sprintf(dest, "%s", "$f17"); break; case 6: sprintf(dest, "%s", "$f18"); break; case 7: sprintf(dest, "%s", "$f19"); break; default: sprintf(dest, "%s", "$f1"); break; } Inst_Printf("la", "$25,pl_foreign_double"); Inst_Printf("l.d", "%s,%d($25)", dest, index * 8); if (offset > 7) { Inst_Printf("s.d", "%s,%d($sp)", dest, (offset - 8) * 8); } return 1; } } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { /* if (!make_inline (fct_name, nb_args)) { */ Inst_Printf("sd", "$gp,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8 + 8); Inst_Printf("sd", "$31,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8); Inst_Printf("la", "$25,%s", fct_name); Inst_Printf("jal", "$25"); Inst_Printf("ld", "$gp,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8 + 8); Inst_Printf("ld", "$31,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8); /* } */ } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Inst_Printf("move", "$25,$2"); Inst_Printf("j", "$25"); } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Inst_Printf("bne", "$2,$0,.Lcont%d", w_label); Pl_Fail(); Label_Printf(".Lcont%d:", w_label++); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { Inst_Printf("la", "$13,%s", name); Inst_Printf("sw", "$2,%d($13)", index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* same as Move_To_Reg_X */ Inst_Printf("sw", "$2,%d(%s)", index * 4, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* same as Move_To_Reg_Y */ #ifdef MAP_REG_E Inst_Printf("sw", "$2,%d(%s)", Y_OFFSET(index), asm_reg_e); #else Inst_Printf("lw", "$13,%s", asm_reg_e); Inst_Printf("sw", "$2,%d($13)", Y_OFFSET(index)); #endif } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { Inst_Printf("la", "$13,pl_foreign_long"); Inst_Printf("sw", "$2,%d($13)", index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { Inst_Printf("la", "$13,pl_foreign_double"); Inst_Printf("s.d", "$f0,%d($13)", index * 8); } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { Inst_Printf("li", "$24,%d", int_val); Inst_Printf("sub", "$12,$2,$24"); /* $2 - $24 -> $12 */ } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Inst_Printf("beqz", "$12,%s", label); /* $2 == 0 */ } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { /* this is based on the comparison we did with Cmp_Ret_And_Int */ /* means this is more or less a Jump_If_Not_Equal ! */ Inst_Printf("bgtz", "$12,%s", label); /* $3 == 1 */ } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Inst_Printf("ld", "$gp,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8 + 8); Inst_Printf("ld", "$31,%d($sp)", MAX_C_ARGS_IN_C_CODE * 8 + 0); Inst_Printf("addiu", "$sp,$sp,%d", MAX_C_ARGS_IN_C_CODE * 8 + 16); Inst_Printf("j", "$31"); } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { Label_Printf(".section\t.rodata"); Inst_Printf(".align", "3"); } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Label_Printf("%s%d:", STRING_PREFIX, str_no); Inst_Printf(".ascii", "%s", asciiz); } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { Label_Printf(".section\t.sdata"); Inst_Printf(".align", "3"); } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: Label_Printf(".section\t.bss"); if (!global) { Label_Printf("%s:", name); Inst_Printf(".align", "3"); Inst_Printf(".space", "%d", value * 4); /* Inst_Printf(".popsection",""); */ } else { Inst_Printf(".comm", "%s,%d", name, value * 4); } break; case INITIAL_VALUE: Label_Printf(".section\t.rodata"); if (global) { Inst_Printf(".globl", "%s", name); Inst_Printf(".align", "3"); Inst_Printf(".size", "%s,4", name); Label_Printf("%s:", name); Inst_Printf(".word", "%d", value); } else { Inst_Printf(".align", "3"); Inst_Printf(".size", "%s,4", name); Label_Printf("%s:", name); Inst_Printf(".word", "%d", value); } break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { /* last routine has to be closed first */ if (act_routine[0] != '\0') { Inst_Printf("j", "$31"); Inst_Printf(".end", "%s", act_routine); act_routine[0] = '\0'; } if (initializer_fct == NULL) return; Inst_Printf(".section", ".ctors,\"aw\",@progbits"); Inst_Printf(".word", "%s", initializer_fct); } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000056�13021324543�015157� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile ma2asm chkma_ma.s chkma extract_asm ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/INLINED��������������������������������������������������������������������0000644�0001750�0001750�00000001016�13021324543�014171� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Get_Atom_Tagged Get_Integer_Tagged Get_Float Get_Nil Get_List Get_Structure_Tagged Put_X_Variable Put_Y_Variable Put_Unsafe_Value Put_Atom_Tagged Put_Integer_Tagged Put_Float Put_Nil Put_List Put_Structure_Tagged Unify_Variable Unify_Void Unify_Value Unify_Local_Value Unify_Atom_Tagged Unify_Integer_Tagged Unify_Nil Unify_List Unify_Structure_Tagged Allocate Deallocate Switch_On_Term Switch_On_Atom Switch_On_Integer Switch_On_Structure Load_Cut_Level Cut Create_Choice_Point Update_Choice_Point Delete_Choice_Point ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/MA_SYNTAX������������������������������������������������������������������0000644�0001750�0001750�00000003171�13021324543�014516� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ma::= code... code::= prolog_code | c_code | decl | comment comment::= ';' ... '\n' prolog_code::= 'pl_code' ( 'local' | 'global' ) label inst... c_code::= 'c_code' ( 'initializer' | 'local' | 'global' ) label inst... inst::= 'pl_jump' pl_label Prolog jump to a predicate 'pl_call' pl_label Prolog call a predicate 'pl_fail' Prolog fail 'pl_ret' Prolog return label ':' declare a label 'jump' label jump to a label 'move' reg1 ',' reg2 move wam reg1 to reg2 'prep_cp' save in CP address of next here_cp 'here_cp' define the address of prev prep_cp 'call_c' [ 'fast' ] fct_name '(' fct_arg ','...')' call a C function (fc = fast call) 'jump_ret' jump at the returned value 'fail_ret' if returned value==0 then 'pl_fail' 'move_ret' ( mem | reg | f_array ) move returned value 'switch_ret' '(' swt_arg '=' label ',' ...) switch on returned value else 'pl_fail' 'c_ret' C return decl::= 'long' ( 'local' | 'global' ) ident [ '=' integer | '(' integer ')' ] fct_arg::= integer | float | string | & label NB: & label = special case of & mem | [ '&' ] mem | [ '&' ] reg | [ '&' ] f_array swt_arg::= mem | integer fct_name::= ident label ::= ident pl_label::= ident mem ::= ident [ '(' integer ')' ] *** Tokens *** ident ::= C identifier integer ::= C int float ::= C double string ::= C string reg ::= ( 'X' | 'Y' ) '(' integer ')' WAM X/Y reg f_array ::= ( 'FL' | 'FD' ) '(' integer ')' foreign long/double array element �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/ma_protos.h����������������������������������������������������������������0000644�0001750�0001750�00000015355�13021324543�015353� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : ma_protos.h * * Descr.: code generation - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "../EnginePl/pl_long.h" #if 0 #define CHECK_PRINTF_ARGS #endif #ifdef CHECK_PRINTF_ARGS #define GCCPRINTF(x) __attribute__((format(printf, x, x + 1))) #else #define GCCPRINTF(x) #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /* defined in mapper files */ #ifndef MAPPER_FILE extern int can_produce_pic_code; extern char *comment_prefix; extern char *local_symb_prefix; extern int strings_need_null; extern int call_c_reverse_args; extern char *inline_asm_data[]; #endif /* defined in ma_parser.c */ #ifndef MA_PARSER_FILE extern int reload_e; #endif #ifndef MA2ASM_FILE extern int pic_code; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ /* defined in ma2asm.c - used by the parser */ void Declare_Initializer(char *initializer_fct); void Call_C(char *fct_name, int fc, int nb_args, int nb_args_in_words, ArgInf arg[]); void Switch_Ret(int nb_swt, SwtInf swt[]); void Decl_Code(char *name, int prolog, int global); void Decl_Long(char *name, int global, VType vtype, PlLong value); /* defined in ma2asm.c - used by mappers */ int Is_Code_Defined(char *name); int Get_Long_Infos(char *name, int *global, VType *vtype, int *value); void Label_Printf(char *label, ...) GCCPRINTF(1); void Inst_Printf(char *op, char *operands, ...) GCCPRINTF(2); void Inst_Out(char *op, char *operands); void Char_Out(char c); void String_Out(char *s); void Int_Out(int d); /* defined in mapper files */ void Asm_Start(void); void Asm_Stop(void); void Code_Start(char *label, int prolog, int global); void Code_Stop(void); void Label(char *label); void Reload_E_In_Register(void); void Pl_Jump(char *label); void Prep_CP(void); void Here_CP(void); void Pl_Call(char *label); void Pl_Fail(void); void Pl_Ret(void); void Jump(char *label); void Move_From_Reg_X(int index); void Move_From_Reg_Y(int index); void Move_To_Reg_X(int index); void Move_To_Reg_Y(int index); void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline); int Call_C_Arg_Int(int offset, PlLong int_val); int Call_C_Arg_Double(int offset, double dbl_val); int Call_C_Arg_String(int offset, int str_no); int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index); int Call_C_Arg_Reg_X(int offset, int adr_of, int index); int Call_C_Arg_Reg_Y(int offset, int adr_of, int index); int Call_C_Arg_Foreign_L(int offset, int adr_of, int index); int Call_C_Arg_Foreign_D(int offset, int adr_of, int index); void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words); void Call_C_Stop(char *fct_name, int nb_args, char **p_inline); void Call_C_Adjust_Stack(int nb_pushes); void Jump_Ret(void); void Fail_Ret(void); void Move_Ret_To_Mem_L(char *name, int index); void Move_Ret_To_Reg_X(int index); void Move_Ret_To_Reg_Y(int index); void Move_Ret_To_Foreign_L(int index); void Move_Ret_To_Foreign_D(int index); void Cmp_Ret_And_Int(PlLong int_val); void Jump_If_Equal(char *label); void Jump_If_Greater(char *label); void C_Ret(void); void Dico_String_Start(int nb); void Dico_String(int str_no, char *asciiz); void Dico_String_Stop(int nb); void Dico_Long_Start(int nb); void Dico_Long(char *name, int global, VType vtype, PlLong value); void Dico_Long_Stop(int nb); void Data_Start(char *initializer_fct); void Data_Stop(char *initializer_fct); #define INL_ACCESS_NAME(p) (p[0]) #define INL_ACCESS_NEXT(p) (p[1]) #define INL_ACCESS_LEVEL(p) (PlLong) (p[2]) #define INL_ACCESS_INFO(p) (PlLong) (p[3]) #define INL_NEXT ((char *) (0)) #define INL_LEVEL(x) ((char *) (x)) #define INL_INFO(x) ((char *) (x)) #define INL_LABEL(x) ((char *) (x)) #define INL_END_FUNC ((char *) (-1)) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/sparc_any.c����������������������������������������������������������������0000644�0001750�0001750�00000070547�13021324543�015326� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : sparc_any.c * * Descr.: translation file for SunOs/Solaris on sparc * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include <stdarg.h> /*---------------------------------* * Constants * *---------------------------------*/ #define STRING_PREFIX ".LC" #ifdef M_sparc_sunos #define UN "_" #else #define UN #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ char asm_reg_bank[20]; char asm_reg_e[20]; char asm_reg_b[20]; char asm_reg_cp[20]; int w_label = 0; char *delay_op; char delay_operands[1024]; /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 0; #if 0 char *comment_prefix = "#"; /* does not work on solaris 9 */ #else char *comment_prefix = "!"; #endif char *local_symb_prefix = "L"; int strings_need_null = 1; int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Delay_Printf(char *op, char *operands, ...); #define LITTLE_INT(int_val) ((unsigned) ((int_val)+4096) < 8192) /*-------------------------------------------------------------------------* * SOURCE_LINE * * * *-------------------------------------------------------------------------*/ void Source_Line(int line_no, char *cmt) { Label_Printf("\t! %6d: %s", line_no, cmt); } /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { #ifdef MAP_REG_BANK sprintf(asm_reg_bank, "%%%s", MAP_REG_BANK); #else strcpy(asm_reg_bank, "%l0"); #endif #ifdef MAP_REG_E sprintf(asm_reg_e, "%%%s", MAP_REG_E); #else strcpy(asm_reg_e, "%l1"); #endif #ifdef MAP_REG_B sprintf(asm_reg_b, "%%%s", MAP_REG_B); #else sprintf(asm_reg_b, "[%s+%d]", asm_reg_bank, MAP_OFFSET_B); #endif #ifdef MAP_REG_CP sprintf(asm_reg_cp, "%%%s", MAP_REG_CP); #else sprintf(asm_reg_cp, "[%s+%d]", asm_reg_bank, MAP_OFFSET_CP); #endif Label_Printf(".text"); Label("fail"); Pl_Fail(); } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { } /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { Label_Printf(""); Inst_Printf(".align", "4"); #if defined(M_sparc_solaris) || defined(M_sparc_bsd) Inst_Printf(".type", UN "%s,#function", label); #endif Inst_Printf(".proc", "020"); if (global) Inst_Printf(".global", UN "%s", label); Label(label); if (!prolog) Inst_Printf("save", "%%sp,-104,%%sp"); } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf("\n" UN "%s:", label); } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { #ifndef MAP_REG_E Inst_Printf("ld", "[%s+%d],%s", asm_reg_bank, MAP_OFFSET_E, asm_reg_e); #endif } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { Inst_Printf("call", UN "%s", label); Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { Inst_Printf("sethi", "%%hi(.Lcont%d-8),%%g1", w_label); Inst_Printf("or", "%%g1,%%lo(.Lcont%d-8),%%g1", w_label); Inst_Printf("st", "%%g1,%s", asm_reg_cp); } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf(".Lcont%d:", w_label++); } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Inst_Printf("call", UN "%s,0", label); #ifdef MAP_REG_CP Inst_Printf("mov", "%%o7,%s", asm_reg_cp); /* delay slot */ #else Inst_Printf("st", "%%o7,%s", asm_reg_cp); /* delay slot */ #endif } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Inst_Printf("ld", "[%s-4],%%o0", asm_reg_b); #else Inst_Printf("ld", "%s,%%o0", asm_reg_b); Inst_Printf("ld", "[%%o0-4],%%o0"); #endif Inst_Printf("call", "%%o0"); Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { #ifdef MAP_REG_CP Inst_Printf("jmp", "%s+8", asm_reg_cp); #else Inst_Printf("ld", "%s,%%o0", asm_reg_cp); Inst_Printf("jmp", "%%o0+8"); #endif Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { Inst_Printf("ba", UN "%s", label); Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Inst_Printf("ld", "[%s+%d],%%o0", asm_reg_bank, index * 4); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { Inst_Printf("ld", "[%s%+d],%%o0", asm_reg_e, Y_OFFSET(index)); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Inst_Printf("st", "%%o0,[%s+%d]", asm_reg_bank, index * 4); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { Inst_Printf("st", "%%o0,[%s%+d]", asm_reg_e, Y_OFFSET(index)); } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { delay_op = NULL; } #define MAX_ARGS_IN_REGS 6 #define BEFORE_ARG \ { \ char r[4]; \ \ if (offset < MAX_ARGS_IN_REGS) \ sprintf(r, "%%o%d", offset); \ else \ strcpy(r, "%l7"); #define AFTER_ARG \ if (offset >= MAX_ARGS_IN_REGS) \ Delay_Printf("st","%s,[%%sp+%d]", r, \ 92 + (offset - MAX_ARGS_IN_REGS) * 4); \ } /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { BEFORE_ARG; if (LITTLE_INT(int_val)) Delay_Printf("mov", "%ld,%s", int_val, r); else { Delay_Printf("sethi", "%%hi(%ld),%s", int_val, r); Delay_Printf("or", "%s,%%lo(%ld),%s", r, int_val, r); } AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { int *p = (int *) &dbl_val; BEFORE_ARG; Delay_Printf("sethi", "%%hi(%d),%s", p[0], r); Delay_Printf("or", "%s,%%lo(%d),%s", r, p[0], r); AFTER_ARG; offset++; BEFORE_ARG; Delay_Printf("sethi", "%%hi(%d),%s", p[1], r); Delay_Printf("or", "%s,%%lo(%d),%s", r, p[1], r); AFTER_ARG; return 2; } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { BEFORE_ARG; Delay_Printf("sethi", "%%hi(%s%d),%s", STRING_PREFIX, str_no, r); Delay_Printf("or", "%s,%%lo(%s%d),%s", r, STRING_PREFIX, str_no, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { BEFORE_ARG; Delay_Printf("sethi", "%%hi(" UN "%s+%d),%s", name, index * 4, r); if (adr_of) Delay_Printf("or", "%s,%%lo(" UN "%s+%d),%s", r, name, index * 4, r); else Delay_Printf("ld", "[%s+%%lo(" UN "%s+%d)],%s", r, name, index * 4, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Delay_Printf("add", "%s,%d,%s", asm_reg_bank, index * 4, r); else Delay_Printf("ld", "[%s+%d],%s", asm_reg_bank, index * 4, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Delay_Printf("add", "%s,%+d,%s", asm_reg_e, Y_OFFSET(index), r); else Delay_Printf("ld", "[%s%+d],%s", asm_reg_e, Y_OFFSET(index), r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Delay_Printf("add", "%%l2,%d,%s", index * 4, r); else Delay_Printf("ld", "[%%l2+%d],%s", index * 4, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { if (adr_of) { BEFORE_ARG; Delay_Printf("add", "%%l3,%d,%s", index * 8, r); AFTER_ARG; return 1; } BEFORE_ARG; Delay_Printf("ld", "[%%l3+%d],%s", index * 8, r); AFTER_ARG; offset++; BEFORE_ARG; Delay_Printf("ld", "[%%l3+%d],%s", index * 8 + 4, r); AFTER_ARG; return 2; } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { Inst_Printf("call", UN "%s", fct_name); if (delay_op) Inst_Out(delay_op, delay_operands); else Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { #ifndef MAP_REG_E if (p_inline && INL_ACCESS_INFO(p_inline)) reload_e = 1; #endif } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Inst_Printf("jmp", "%%o0"); Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Inst_Printf("cmp", "%%o0,0"); #if 0 Inst_Printf("be", UN "fail"); Inst_Printf("nop", ""); /* delay slot */ #else Inst_Printf("be", UN "%s+4", "fail"); #ifdef MAP_REG_B Inst_Printf("ld", "[%s-4],%%o0", asm_reg_b); #else Inst_Printf("ld", "%s,%%o0", asm_reg_b); #endif #endif } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { Inst_Printf("sethi", "%%hi(" UN "%s+%d),%%o1", name, index * 4); Inst_Printf("st", "%%o0,[%%o1+%%lo(" UN "%s+%d)]", name, index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* same as Move_To_Reg_X */ Inst_Printf("st", "%%o0,[%s+%d]", asm_reg_bank, index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* same as Move_To_Reg_Y */ Inst_Printf("st", "%%o0,[%s%+d]", asm_reg_e, Y_OFFSET(index)); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { Inst_Printf("st", "%%o0,[%%l2+%d]", index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { Inst_Printf("std", "%%f0,[%%l3+%d]", index * 8); } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { if (LITTLE_INT(int_val)) Inst_Printf("cmp", "%%o0,%ld", int_val); else { Inst_Printf("sethi", "%%hi(%ld),%%o1", int_val); Inst_Printf("or", "%%o1,%%lo(%ld),%%o1", int_val); Inst_Printf("cmp", "%%o0,%%o1"); } } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Inst_Printf("be", UN "%s", label); Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { Inst_Printf("bg", UN "%s", label); Inst_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Inst_Printf("ret", ""); Inst_Printf("restore", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { Inst_Printf(".section", "\".rodata\""); } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Inst_Printf(".align", "8"); Label_Printf("%s%d:", STRING_PREFIX, str_no); Inst_Printf(".asciz", "%s", asciiz); } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { #ifdef M_sparc_sunos Label_Printf(".data"); #else Inst_Printf(".section", "\".data\""); #endif Inst_Printf(".align", "4"); } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: #ifdef M_sparc_sunos if (!global) Inst_Printf(".reserve", UN "%s,%ld,\"bss\",4", name, value * 4); else Inst_Printf(".common", UN "%s,%ld,\"bss\"", name, value * 4); #else if (!global) Inst_Printf(".local", UN "%s", name); Inst_Printf(".common", UN "%s,%ld,4", name, value * 4); #endif break; case INITIAL_VALUE: #if defined(M_sparc_solaris) || defined(M_sparc_bsd) Inst_Printf(".type", UN "%s,#object", name); Inst_Printf(".size", UN "%s,4", name); #endif if (global) Inst_Printf(".global", UN "%s", name); Label_Printf(UN "%s:", name); #ifdef M_sparc_sunos Inst_Printf(".word", "%ld", value); #else Inst_Printf(".uaword", "%ld", value); #endif break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { if (initializer_fct == NULL) return; Inst_Printf(".section", "\".ctors\",#alloc,#write"); Inst_Printf(".align", "4"); Inst_Printf(".long", UN "%s", initializer_fct); } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { } /*-------------------------------------------------------------------------* * DELAY_PRINTF * * * *-------------------------------------------------------------------------*/ void Delay_Printf(char *op, char *operands, ...) { va_list arg_ptr; if (delay_op) Inst_Out(delay_op, delay_operands); va_start(arg_ptr, operands); delay_op = op; vsprintf(delay_operands, operands, arg_ptr); } ���������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/FromC/���������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�014200� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/FromC/mach.h���������������������������������������������������������������0000644�0001750�0001750�00000005544�13021324543�015265� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * Prolog To Wam Compiler INRIA Rocquencourt - CLoE Project * * C Run-time Daniel Diaz - 1994 * * * * Machine Dependent Features - Header file * * * * machine.h * *-------------------------------------------------------------------------*/ /*---------------------------------* * Asm Labels, Symbols and Gotos * *---------------------------------*/ #if defined(M_sony_news) || defined(M_ultrix_dec) || defined(M_alpha_osf) ||\ defined(M_ix86_linux) || defined(M_ix86_sco) || defined(M_ix86_bsd) ||\ defined(M_x86_64_linux) || defined(m_x86_64_bsd) || \ defined(M_powerpc_bsd) || defined(M_sparc_bsd) || defined(__ELF__) # define M_Asm_Symbol1(name) #name # define M_Asm_Symbol(name) M_Asm_Symbol1(name) #elif defined (M_ix86_win32) # define M_Asm_Symbol1(name) _##name # define M_Asm_Symbol(name) M_Asm_Symbol1(name) #else # define M_Asm_Symbol1(name) "_"#name # define M_Asm_Symbol(name) M_Asm_Symbol1(name) #endif #if defined(M_ix86_win32) #define M_Indirect_Goto(p_lab) {register long adr=(long) p_lab; _asm jmp adr} #else #define M_Indirect_Goto(p_lab) {goto *(void*) p_lab;} #endif #if defined(M_sparc_sunos) || defined(M_ultrix_dec) || \ defined(M_sony_news) || defined(M_hppa_NeXT) # define M_Direct_Goto(lab) {lab(); return;} #elif defined(M_alpha_osf) # define M_Direct_Goto(lab) {asm("lda $28," M_Asm_Symbol(lab)); \ asm("jmp $31,($28)," M_Asm_Symbol(lab));\ return;} #elif defined(M_ix86) && defined(__GNUC__) # define M_Direct_Goto(lab) {asm("jmp " M_Asm_Symbol(lab)); return;} #elif defined(_MSC_VER) # define M_Direct_Goto(lab) {_asm {jmp M_Asm_Symbol(lab)}; return;} #elif defined(M_x86_64_linux) || defined(M_x86_64_solaris) || defined(M_x86_64_bsd) # define M_Direct_Goto(lab) {asm("jmp " M_Asm_Symbol(lab)); return;} #elif defined(M_powerpc_linux) || defined(M_powerpc_bsd) # define M_Direct_Goto(lab) {asm("b " M_Asm_Symbol(lab)); return;} #elif defined(M_m68k_NeXT) # define M_Direct_Goto(lab) {asm("jmp " M_Asm_Symbol(lab)); return;} #endif /*---------------------------------* * WAM * *---------------------------------*/ #if 0 #if defined(M_ix86) register WamWord *reg_bank asm("ebx"); #elif defined(M_powerpc) register WamWord *reg_bank asm("r31"); #elif defined(M_x86_64) register WamWord *reg_bank asm("r12"); #else WamWord *reg_bank; #endif #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/FromC/asm_inst.c�����������������������������������������������������������0000644�0001750�0001750�00000013773�13021324543�016170� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #define OBJ_INIT initializer_fct #include "../../EnginePl/gp_config.h" #include "../../EnginePl/pl_params.h" #if 1 /* #if 0, cp ../../EnginePl/wam_archi.h . and customize it if needed */ #include "../../EnginePl/wam_archi.h" #else #include "wam_archi.h" #endif #if 0 /* to define Reload_E_In_Register() */ register long *EINREG asm("%l0"); void TRANS_reload_E() { EINREG = E; } #endif #include "../../EnginePl/machine.h" #include "../../EnginePl/obj_chain.h" #include "../../EnginePl/wam_inst.h" #include "mach.h" #define YY(k) Y(E,k) extern unsigned var; extern void *label; intptr_t v1[100]; static intptr_t v2[100]; extern intptr_t v3[100]; void foo(); void foo1(); void pl_call1(); int x, y; extern intptr_t pl_foreign_long[]; extern double pl_foreign_double[]; /* to define Asm_Start() */ /* to define Code_Start() (global/not global) and Code_Stop() */ void Dummy(); void Save_CP(); void foooo(); void TRANS_code_start_global() { Dummy(); Save_CP(); foooo(1,2,3); } static void TRANS_code_start_non_global() { } /* to define Pl_Jump() */ void TRANS_pl_jump() { M_Direct_Goto(foo1); _foo1:; } //static void check() { CodePtr adr = (CodePtr) &&cont; bar(adr); cont: baz(CP); } /* to define Pl_Call() */ void TRANS_pl_call() { #ifdef __GNUC__ CP = (CodePtr) &&cont; M_Direct_Goto(foo); cont: #else CP = (CodePtr) pl_call1; M_Direct_Goto(foo); _foo:; #endif dummy(CP); } void TRANS_pl_call_another() { CP = (CodePtr) &&cont; foo(); cont: CP = (CodePtr) &var; dummy(CP); cont2: CP = (CodePtr) &&cont2; dummy(var); } /* to define Pl_Fail() */ void TRANS_pl_fail() { M_Indirect_Goto(ALTB(B)); } /* to define Pl_Ret() */ void TRANS_pl_ret() { M_Indirect_Goto(CP); } /* to define Prep_CP() and Here_CP() */ void TRANS_prep_cp_here_cp() { CP = &&a; if (x<3) { bar(x); } a:; } /* to define Jump() */ void TRANS_jump() { if (x < 3) { bar(x); goto a; } x++; a:; } /* to define Move_From/To_Reg_X/Y() */ void TRANS_move_x_to_x() { X(3) = X(5); } void TRANS_move_x_to_y() { YY(10) = X(2); } void TRANS_move_y_to_x() { X(0) = YY(3); } void TRANS_move_y_to_y() { YY(2) = YY(4); } /* to define Call_C_Start() + Call_C_Arg()... + Call_C_Stop() */ void TRANS_call_c(void) { dummy(); /* &label,var,int, double, string */ bar(foo, var, 12, 4098, -4095, (double) 1.20e-10, "this is a string", "a\14b"); /* v(index) */ bar1(v1[2], v1[0], &v1[12], v2[2], v2[0], &v2[4]); bar1(v3[4], &v3[2], v3[0]); /* regs / ®s */ bar2(X(0), &X(4), YY(0), &YY(12)); } void TRANS_call_c_lot_of_args(void) { /* &label,var,int, double, string */ bar(3, 4, 5, 6, 7, 8, 9, 10, foo, var, 12, 4098, -4095, (double) 1.20e-10, "this is a string", "a\14b"); /* regs / ®s */ bar1(0, 0, 0, 0, 0, 0, X(2), &X(4), YY(0), &YY(12)); } void TRANS_call_c_foreign(void) { bar(pl_foreign_long[0], pl_foreign_long[4], &pl_foreign_long[0], &pl_foreign_long[8]); bar(pl_foreign_double[0], pl_foreign_double[4], &pl_foreign_double[0], &pl_foreign_double[8]); } /* to define Jump_Ret() */ void TRANS_jump_ret() { #if defined(M_ix86_win32) register intptr_t adr = (intptr_t) bar(12, "toto"); _asm { jmp adr} #else goto *bar(12, "toto"); #endif } /* to define Fail_Ret() */ void TRANS_fail_ret() { if (test(1, 2, 3) == 0) goto a; x++; a:; } /* to define Move_Ret_To_Mem() */ void TRANS_move_ret_to_mem() { var = bar(3); v1[4120] = bar(15); } /* to define Move_Ret_To_Reg_X() */ void TRANS_move_ret_to_reg_x() { X(4) = bar(3); } /* to define Move_Ret_To_Reg_Y() */ void TRANS_move_ret_to_reg_y() { YY(2) = bar(3); } /* to define Move_Ret_To_Pl_Foreign_L() */ void TRANS_move_ret_to_pl_foreign_l() { pl_foreign_long[123] = bar(3); } /* to define Move_Ret_To_Pl_Foreign_D() */ void TRANS_move_ret_to_pl_foreign_d() { double bard(void); pl_foreign_double[123] = bard(); } /* to define Cmp_Ret_And_Int() */ void TRANS_cmp_ret_and_int() { if (bar(foo) == 0) /* case ret = 0 */ goto a; if (bar(foo) == 12345678) /* case ret !- 0 */ goto a; x++; a:; } /* to define Jump_If_Equal() */ void TRANS_jump_if_equal() { if (x == y) goto a; x++; a:; } /* to define Jump_If_Greater() */ /* maybe the C compiler does not generate a jg but a jl, reverse if needed */ void TRANS_jump_if_greater() { if (x > 12) goto a; if (y > x) goto a; x++; a: foo(1); } /* to define C_Ret() */ void TRANS_c_ret() { } /* to define Dico_String_Start() + Dico_String() + Dico_String_Stop() */ /* see definitions of strings in the asm file produced */ void TRANS_dico_string() { bar("str1", "str2", "str3", "str\r\tend\n", "str\019toto"); } /* to define Dico_Long_Start() + Dico_Long() + Dico_Long_Stop() */ /* see definitions of intptr_ts in the asm file produced (global/not global)*/ static intptr_t var_long_static_uninit; static intptr_t var_long_static_init0; static intptr_t var_long_static_init100 = 100; intptr_t var_long_common_unint; intptr_t var_long_common_init128 = 128; intptr_t ma_array[5000]; intptr_t ma_global_var1; intptr_t ma_global_var2 = 12345; uint64_t ma_global_var2bis = 12345; static intptr_t ma_local_var1; static intptr_t ma_local_var2 = 128; static intptr_t var_array_static128[128]; intptr_t var_array_common128[128]; /* to define Data_Start() + Data_Stop */ /* between obj_chain_start and obj_chain_stop */ static void initializer_fct() { /* the following printf to ensure gcc does not remove unused static vars */ printf("%p %p\n", &ma_local_var1, &ma_local_var2); printf("%ld %ld %ld %p\n", var_long_static_uninit, var_long_static_init0, var_long_static_init100, var_array_static128); dummy(12); } # if 0 /* this should not be useful */ int see_switch() { int y; int x = bar(); if (x == 10) y += 11; if (x > 10) y += 12; if (x < 10) y += 13; if (x == 0) y += 1; if (x > 0) y += 2; if (x < 0) y += 3; return y; } #endif �����gprolog-1.4.5/src/Ma2Asm/FromC/.gitignore�����������������������������������������������������������0000644�0001750�0001750�00000000041�13021324543�016157� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile asm_inst.s wam_archi.h �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/FromC/sparc64-setx.c�������������������������������������������������������0000644�0001750�0001750�00000010263�13021324543�016605� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#include <stdio.h> #include <stdlib.h> #include <string.h> #include <stdarg.h> FILE *f; void Delay_Printf(char *op, char *operands, ...) { char buff[100]; va_list arg_ptr; va_start(arg_ptr, operands); sprintf(buff, "\t%s\t", op); vsprintf(buff + strlen(buff), operands, arg_ptr); va_end(arg_ptr); printf("%s\n", buff); fprintf(f, "%s\n", buff); } void synthetize_setx(long value, char *dstreg) { int upper32 = value >> 32; int lower32 = value; char *upper_dstreg = "%g1"; /* a temp reg */ int need_hh22_p = 0, need_hm10_p = 0, need_hi22_p = 0, need_lo10_p = 0; int need_xor10_p = 0; /* What to output depends on the number if it's constant. Compute that first, then output what we've decided upon. */ /* Only need hh22 if `or' insn can't handle constant. */ if (upper32 < -(1 << 12) || upper32 >= (1 << 12)) need_hh22_p = 1; /* Does bottom part (after sethi) have bits? */ if ((need_hh22_p && (upper32 & 0x3ff) != 0) /* No hh22, but does upper32 still have bits we can't set from lower32? */ || (! need_hh22_p && upper32 != 0 && upper32 != -1)) need_hm10_p = 1; /* If the lower half is all zero, we build the upper half directly into the dst reg. */ if (lower32 != 0 /* Need lower half if number is zero or 0xffffffff00000000. */ || (! need_hh22_p && ! need_hm10_p)) { /* No need for sethi if `or' insn can handle constant. */ if (lower32 < -(1 << 12) || lower32 >= (1 << 12) /* Note that we can't use a negative constant in the `or' insn unless the upper 32 bits are all ones. */ || (lower32 < 0 && upper32 != -1) || (lower32 >= 0 && upper32 == -1)) need_hi22_p = 1; if (need_hi22_p && upper32 == -1) need_xor10_p = 1; /* Does bottom part (after sethi) have bits? */ else if ((need_hi22_p && (lower32 & 0x3ff) != 0) /* No sethi. */ || (! need_hi22_p && (lower32 & 0x1fff) != 0) /* Need `or' if we didn't set anything else. */ || (! need_hi22_p && ! need_hh22_p && ! need_hm10_p)) need_lo10_p = 1; } else /* Output directly to dst reg if lower 32 bits are all zero. */ upper_dstreg = dstreg; #define MK_IMM22(x) (((x) >> 10) & 0x3fffff) #define MK_SIMM10_13(x, want10) ((x) & ((want10) ? 0x3ff : 0x1fff)) if (need_hh22_p) Delay_Printf("sethi", "%d,%s", MK_IMM22(upper32), upper_dstreg); if (need_hi22_p) Delay_Printf("sethi", "%d,%s", MK_IMM22(need_xor10_p ? ~lower32 : lower32), dstreg); if (need_hm10_p) Delay_Printf("or", "%s,%ld,%s", (need_hh22_p ? upper_dstreg : "%g0"), MK_SIMM10_13(upper32, need_hh22_p), upper_dstreg); if (need_lo10_p) Delay_Printf("or", "%s,%ld,%s", (need_hi22_p ? dstreg : "%g0"), MK_SIMM10_13(lower32, need_hi22_p), dstreg); /* If we needed to build the upper part, shift it into place. */ if (need_hh22_p || need_hm10_p) Delay_Printf("sllx", "%s,32,%s", upper_dstreg, upper_dstreg); /* To get -1 in upper32, we do sethi %hi(~x), r; xor r, -0x400 | x, r. */ if (need_xor10_p) Delay_Printf("xor", "%s,%ld,%s", dstreg, 0x1c00 | (lower32 & 0x3ff), dstreg); /* If we needed to build both upper and lower parts, OR them together. */ else if ((need_hh22_p || need_hm10_p) && (need_hi22_p || need_lo10_p)) Delay_Printf("or", "%s,%s,%s", dstreg, upper_dstreg, dstreg); } void as_disass(char *pref) { char buff[100]; printf("AS-DISAS %s.s\n", pref); sprintf(buff, "as -s -K PIC -Av9a -64 -o %s.o %s.s", pref, pref); if (system(buff) != 0) exit(1); sprintf(buff, "cp %s.o z.o", pref); /* to have the same object file name at disass */ system(buff); sprintf(buff, "objdump --disassemble z.o >%s-1.s", pref); if (system(buff) != 0) exit(1); } int main(int argc, char *argv[]) { long value = strtol(argv[1], NULL, 0); printf("Value: %ld 0x%lx\n", value, value); f = fopen("x.s", "w"); synthetize_setx(value, "%o1"); fclose(f); printf("\n"); f = fopen("y.s", "w"); fprintf(f, "\tsetx %ld,%%g1,%%o1\n", value); fclose(f); as_disass("x"); as_disass("y"); if (system("cmp x-1.s y-1.s") != 0) { printf("ERROR\n"); printf("diff x-1.s y-1.s\n"); system("diff x-1.s y-1.s"); } return 0; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/FromC/asm.c����������������������������������������������������������������0000644�0001750�0001750�00000002551�13021324543�015123� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������//long mydata; long bar(void); /* void foo(long mydata){ bar(mydata); baz(); } */ #if 0 //static void __attribute__ ((constructor)) void initializer_fct(void) { // bar(-1234567891234567); // //bar(0xABCD1234); if (bar() == -1412623820) foo(); // bar(-1234567); } #endif void baz(long,double,long,long,long,long,long,long,long,long,long,long,long,long,long,double); double d = 3.1415926535897932384626; int t[10]; void f() { bar5(t); baz(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,(double) 3.1415926535897932384626); } //void foo1(long); void foo(double); void g() { foo1(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,1.2,21); } static foo44(){ } void fprep_cp() { f(&foo44); } void fstr() { f("toto", "titi", "tutu"); } long mem; long mem_array[100]; void fmem() { foo3(mem); foo3(mem_array[4102]); } void fmem_adr(){ foo4(&mem); foo4(&mem_array[4096]); } double *fd; void ffd(){ register double *fd asm("%l3"); foo(fd[10]); foo(fd[4102]); } void ffd_adr(){ register double *fd asm("%l3"); foo4(&fd[10]); foo4(&fd[4102]); } void test_call_c_lot_args(); static long ma_local_var2; void flot(){ register long *X asm("%l0"); register long *Y asm("%l1"); test_call_c_lot_args1(0,0,0,0,0,0,&test_call_c_lot_args,ma_local_var2,4095,123456789,-3.141593,"abcd\01489def\n\r",X[0],&X[0],X[255],&X[128],Y[0],&Y[0],Y[12],&Y[6], 1.23456); } �������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/FromC/Makefile.in����������������������������������������������������������0000644�0001750�0001750�00000000464�13021324543�016245� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GPLC = @GPLC@ CC = @CC@ CFLAGS = @CFLAGS@ # other local variables #CFLAGS = -O3 #CFLAGS = -O3 -fverbose-asm -fomit-frame-pointer CFLAGS = -O3 -fverbose-asm -fomit-frame-pointer -fno-defer-pop #CFLAGS= /Ox /Oy opt: $(CC) -S $(CFLAGS) asm_inst.c no: $(CC) -S asm_inst.c clean: -rm *.s ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/sparc64_any.c��������������������������������������������������������������0000644�0001750�0001750�00000113426�13021324543�015472� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : sparc64_any.c * * Descr.: translation file for BSD on sparc64 * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include <stdarg.h> /*---------------------------------* * Constants * *---------------------------------*/ #define STRING_PREFIX ".LC" #define UN /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ char asm_reg_bank[20]; char asm_reg_e[20]; char asm_reg_b[20]; char asm_reg_cp[20]; int w_label = 0; char cur_fct_label[1024]; int pic_helper_ready = 0; char buff[1024]; int delay_active = 0; char *delay_op = NULL; char delay_operands[1024]; /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 1; char *comment_prefix = "!"; char *local_symb_prefix = "L"; int strings_need_null = 1; int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Delay_Printf(char *op, char *operands, ...); int Delay_Flush(void); /* LITTLE_INT for signed 13 bits, ie: ((x) >= -4096 && (x) < 4096) */ #if 1 /* put 0 to force loading into reg instead of simm13 (for check only) */ #define OK_FOR_SIMM13(x) ((unsigned) ((x) + 4096) < 8192) #else #define OK_FOR_SIMM13(x) 0 #endif /* On sparc64 (sparc v9) / OpenBSD we can use the following registers: * * %g1 - %g4 mainly temporaries * %o1 - %o5 argument passing for function call or temporaries * %l0 - %l7 local regs usable because callee saved * * We can safely use %l registers in Prolog code even if they are callee * save and even if in Prolog code we do not save them (no save/restore). * This is because Prolog code is called via Pl_Call_Compiled (see engine1.c) * which saves them (callee save). It is even possible to use them as global * registers to store constant values (e.g. pl_reg_bank) if the are set by * Pl_Call_Compiled(). We use * * %l0 for pl_reg_bank * %l2 for pl_base_fl (pl_foreign_long) * %l3 for pl_base_fd (pl_foreign_double) * * %l1 is used to load E (reloaded after a call to an Allocate function) * * %l7 is used for PIC register (on On OpenBSD all code is PIC) * NB: it is important to inform the assembler about this passing -K PIC * (see configure.in) * * To pass a floating point literal (double) we build it using 64 bits * instructions and then move it to a float register (%fnn) using store/load * (as done by gcc 4.2.1). It would be possible to store them in the data * section and load the float register with this data (as done by gcc 4.8.2). * The would be very similar to what is done in x86_64_any.c. */ /*-------------------------------------------------------------------------* * SOURCE_LINE * * * *-------------------------------------------------------------------------*/ void Source_Line(int line_no, char *cmt) { Label_Printf("\t! %6d: %s", line_no, cmt); } /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { #ifdef MAP_REG_BANK sprintf(asm_reg_bank, "%%%s", MAP_REG_BANK); #else strcpy(asm_reg_bank, "%l0"); #endif #ifdef MAP_REG_E sprintf(asm_reg_e, "%%%s", MAP_REG_E); #else strcpy(asm_reg_e, "%l1"); #endif #ifdef MAP_REG_B sprintf(asm_reg_b, "%%%s", MAP_REG_B); #else sprintf(asm_reg_b, "[%s+%d]", asm_reg_bank, MAP_OFFSET_B); #endif #ifdef MAP_REG_CP sprintf(asm_reg_cp, "%%%s", MAP_REG_CP); #else sprintf(asm_reg_cp, "[%s+%d]", asm_reg_bank, MAP_OFFSET_CP); #endif Delay_Printf(".section", "\".text\""); Label("fail"); Pl_Fail(); } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { Delay_Printf(".section", ".gnu.linkonce.t.__sparc_get_pc_thunk.l7,\"ax\",@progbits"); Delay_Printf(".align", "4"); Delay_Printf(".weak", "__sparc_get_pc_thunk.l7"); Delay_Printf(".hidden", "__sparc_get_pc_thunk.l7"); Delay_Printf(".type", "__sparc_get_pc_thunk.l7,@function"); Delay_Printf(".proc", "020"); Label("__sparc_get_pc_thunk.l7"); Delay_Printf("jmp", "%%o7+8"); Delay_Printf("add", "%%o7, %%l7, %%l7"); } /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { Label_Printf(""); Delay_Printf(".align", "4"); Delay_Printf(".align", "32"); #if defined(M_sparc64_solaris) || defined(M_sparc64_bsd) Delay_Printf(".type", UN "%s,#function", label); #endif Delay_Printf(".proc", "020"); if (global) Delay_Printf(".global", UN "%s", label); Label(label); if (!prolog) Delay_Printf("save", "%%sp,-192,%%sp"); pic_helper_ready = 0; strcpy(cur_fct_label, label); } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { /* this directive is mandatory else asm call are wrong (PC relative) */ Delay_Printf(".size", "%s,.-%s", cur_fct_label, cur_fct_label); } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf("\n" UN "%s:", label); } /*-------------------------------------------------------------------------* * ENSURE_PIC_HELPER * * * *-------------------------------------------------------------------------*/ void Ensure_PIC_Helper(void) { if (pic_helper_ready) return; Delay_Printf("sethi", "%%hi(_GLOBAL_OFFSET_TABLE_-4), %%l7"); Delay_Printf("call", "__sparc_get_pc_thunk.l7"); Delay_Printf("add", "%%l7, %%lo(_GLOBAL_OFFSET_TABLE_+4), %%l7"); pic_helper_ready = 1; } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { #ifndef MAP_REG_E Delay_Printf("ldx", "[%s+%d],%s", asm_reg_bank, MAP_OFFSET_E, asm_reg_e); #endif } /*-------------------------------------------------------------------------* * SYNTHETIZE_SETX * * * * This corresponds to the mapping of the setx synthetic instruction * * (see table 37 of The SPARC Architecture Manual Version 9) * * The following code is adapted from GNU binutils/gas, file tc-sparc.c * *-------------------------------------------------------------------------*/ void Synthetize_Setx(long value, char *tmpreg, char *dstreg) { int upper32 = value >> 32; int lower32 = value; char *upper_dstreg = tmpreg; int need_hh22_p = 0, need_hm10_p = 0, need_hi22_p = 0, need_lo10_p = 0; int need_xor10_p = 0; /* What to output depends on the number if it's constant. Compute that first, then output what we've decided upon. */ /* Only need hh22 if `or' insn can't handle constant. */ if (!OK_FOR_SIMM13(upper32)) need_hh22_p = 1; /* Does bottom part (after sethi) have bits? */ if ((need_hh22_p && (upper32 & 0x3ff) != 0) /* No hh22, but does upper32 still have bits we can't set from lower32? */ || (! need_hh22_p && upper32 != 0 && upper32 != -1)) need_hm10_p = 1; /* If the lower half is all zero, we build the upper half directly into the dst reg. */ if (lower32 != 0 /* Need lower half if number is zero or 0xffffffff00000000. */ || (! need_hh22_p && ! need_hm10_p)) { /* No need for sethi if `or' insn can handle constant. */ if (!OK_FOR_SIMM13(lower32) /* Note that we can't use a negative constant in the `or' insn unless the upper 32 bits are all ones. */ || (lower32 < 0 && upper32 != -1) || (lower32 >= 0 && upper32 == -1)) need_hi22_p = 1; if (need_hi22_p && upper32 == -1) need_xor10_p = 1; /* Does bottom part (after sethi) have bits? */ else if ((need_hi22_p && (lower32 & 0x3ff) != 0) /* No sethi. */ || (! need_hi22_p && (lower32 & 0x1fff) != 0) /* Need `or' if we didn't set anything else. */ || (! need_hi22_p && ! need_hh22_p && ! need_hm10_p)) need_lo10_p = 1; } else /* Output directly to dst reg if lower 32 bits are all zero. */ upper_dstreg = dstreg; #define MK_IMM22(x) (((x) >> 10) & 0x3fffff) #define MK_SIMM10_13(x, want10) ((x) & ((want10) ? 0x3ff : 0x1fff)) if (need_hh22_p) Delay_Printf("sethi", "%d,%s", MK_IMM22(upper32), upper_dstreg); if (need_hi22_p) Delay_Printf("sethi", "%d,%s", MK_IMM22(need_xor10_p ? ~lower32 : lower32), dstreg); if (need_hm10_p) Delay_Printf("or", "%s,%ld,%s", (need_hh22_p ? upper_dstreg : "%g0"), MK_SIMM10_13(upper32, need_hh22_p), upper_dstreg); if (need_lo10_p) Delay_Printf("or", "%s,%ld,%s", (need_hi22_p ? dstreg : "%g0"), MK_SIMM10_13(lower32, need_hi22_p), dstreg); /* If we needed to build the upper part, shift it into place. */ if (need_hh22_p || need_hm10_p) Delay_Printf("sllx", "%s,32,%s", upper_dstreg, upper_dstreg); /* To get -1 in upper32, we do sethi %hi(~x), r; xor r, -0x400 | x, r. */ if (need_xor10_p) Delay_Printf("xor", "%s,%ld,%s", dstreg, 0x1c00 | (lower32 & 0x3ff), dstreg); /* If we needed to build both upper and lower parts, OR them together. */ else if ((need_hh22_p || need_hm10_p) && (need_hi22_p || need_lo10_p)) Delay_Printf("or", "%s,%s,%s", dstreg, upper_dstreg, dstreg); } /*-------------------------------------------------------------------------* * LOAD_LONG_INTO_REG * * * *-------------------------------------------------------------------------*/ void Load_Long_Into_Reg(PlLong x, char *reg) { Synthetize_Setx(x, "%g2", reg); } /*-------------------------------------------------------------------------* * LOAD_MEM_INTO_REG * * * *-------------------------------------------------------------------------*/ void Load_Mem_Into_Reg(char *mem_base_reg, int displ, int adr_of, char *reg) { static char tmp[32]; char *str_displ; if (OK_FOR_SIMM13(displ)) { str_displ = tmp; sprintf(str_displ, "%d", displ); } else { str_displ = "%g1"; Load_Long_Into_Reg(displ, str_displ); } if (!adr_of) Delay_Printf("ldx", "[%s+%s],%s", mem_base_reg, str_displ, reg); else if (displ != 0 || strcmp(mem_base_reg, reg) != 0) /* avoid add r,0,r = nop */ Delay_Printf("add", "%s,%s,%s", mem_base_reg, str_displ, reg); } /*-------------------------------------------------------------------------* * STORE_REG_INTO_MEM * * * *-------------------------------------------------------------------------*/ void Store_Reg_Into_Mem(char *reg, char *mem_base_reg, int displ) { static char tmp[32]; char *str_displ; if (OK_FOR_SIMM13(displ)) { str_displ = tmp; sprintf(str_displ, "%d", displ); } else { str_displ = "%g1"; Load_Long_Into_Reg(displ, str_displ); } Delay_Printf((reg[1] != 'f') ? "stx" : "std", "%s,[%s+%s]", reg, mem_base_reg, str_displ); } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { Delay_Printf("call", UN "%s,0", label); Delay_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { Ensure_PIC_Helper(); #if 1 /* .Lcont - 8 to (un)adjust CP */ Delay_Printf("sethi", "%%hi(_GLOBAL_OFFSET_TABLE_-(.Lcont%d-.-8)),%%g1", w_label); Delay_Printf("or", "%%g1,%%lo(_GLOBAL_OFFSET_TABLE_-(.Lcont%d-.-8)),%%g1", w_label); Delay_Printf("sub","%%l7,%%g1,%%g1"); Delay_Printf("stx", "%%g1,%s", asm_reg_cp); #else Delay_Printf("sethi", "%%hi(.Lcont%d),%%g1", w_label); Delay_Printf("or", "%%g1,%%lo(.Lcont%d),%%g1", w_label); Delay_Printf("ldx", "[%%l7+%%g1],%%g1"); Delay_Printf("sub", "%%g1,8,%%g1"); /* -8 to (un)adjust CP */ Delay_Printf("stx", "%%g1,%s", asm_reg_cp); #endif } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf(".Lcont%d:", w_label++); pic_helper_ready = 0; } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Delay_Printf("call", UN "%s,0", label); #ifdef MAP_REG_CP Delay_Printf("mov", "%%o7,%s", asm_reg_cp); /* delay slot */ #else Delay_Printf("stx", "%%o7,%s", asm_reg_cp); /* delay slot */ #endif pic_helper_ready = 0; } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Delay_Printf("ldx", "[%s-8],%%o0", asm_reg_b); #else Delay_Printf("ldx", "%s,%%o0", asm_reg_b); Delay_Printf("ldx", "[%%o0-8],%%o0"); #endif Delay_Printf("call", "%%o0"); Delay_Printf("nop", ""); /* delay slot */ pic_helper_ready = 0; } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { #ifdef MAP_REG_CP #else Delay_Printf("ldx", "%s,%%o0", asm_reg_cp); Delay_Printf("jmp", "%%o0+8"); #endif Delay_Printf("nop", ""); /* delay slot */ pic_helper_ready = 0; } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { Delay_Printf("ba", UN "%s", label); Delay_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Load_Mem_Into_Reg(asm_reg_bank, index * 8, 0, "%o0"); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { Load_Mem_Into_Reg(asm_reg_e, Y_OFFSET(index), 0, "%o0"); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Store_Reg_Into_Mem("%o0", asm_reg_bank, index * 8); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { Store_Reg_Into_Mem("%o0", asm_reg_e, Y_OFFSET(index)); } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { delay_active = 1; delay_op = NULL; } #define MAX_ARGS_IN_REGS 6 #define BEFORE_ARG \ { \ char r[4]; \ \ if (offset < MAX_ARGS_IN_REGS) \ sprintf(r, "%%o%d", offset); \ else \ strcpy(r, "%l4"); #define STACK_BIAS 2047 #define STACK_OFFSET(offset) (STACK_BIAS + 176 + ((offset) - MAX_ARGS_IN_REGS) * 8) #define AFTER_ARG \ if (offset >= MAX_ARGS_IN_REGS) \ Delay_Printf("stx","%s,[%%sp+%d]", r, \ STACK_OFFSET(offset)); \ } #define MAX_FP_ARGS_IN_REGS 16 #define BEFORE_FP_ARG \ { \ char *r = "%g1"; /* load in a temp */ /* floating point args in %f0, %f2, %f4 (double precision) */ #define AFTER_FP_ARG \ if (offset < MAX_FP_ARGS_IN_REGS) \ { \ Delay_Printf("stx","%s,[%%fp+2023]", r); \ Delay_Printf("ldd","[%%fp+2023],%%f%d", offset * 2); \ } \ else \ Delay_Printf("stx","%s,[%%sp+%d]", r, STACK_OFFSET(offset)); \ } /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { BEFORE_ARG; Load_Long_Into_Reg(int_val, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { long *p = (long *) &dbl_val; BEFORE_FP_ARG; Load_Long_Into_Reg(*p, r); AFTER_FP_ARG; return 1; } /*-------------------------------------------------------------------------* * LOAD_MEM_BASE_INTO_REG * * * *-------------------------------------------------------------------------*/ void Load_Mem_Base_Into_Reg(char *label, int displ, char *reg) { Ensure_PIC_Helper(); Delay_Printf("sethi", "%%hi(%s),%s", label, reg); Delay_Printf("or", "%s,%%lo(%s),%s", reg, label, reg); Delay_Printf("ldx", "[%%l7+%s],%s", reg, reg); } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { BEFORE_ARG; Ensure_PIC_Helper(); sprintf(buff, "%s%d", STRING_PREFIX, str_no); Load_Mem_Base_Into_Reg(buff, 0, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { BEFORE_ARG; Load_Mem_Base_Into_Reg(name, 0, r); Load_Mem_Into_Reg(r, index * 8, adr_of, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { BEFORE_ARG; Load_Mem_Into_Reg(asm_reg_bank, index * 8, adr_of, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { BEFORE_ARG; Load_Mem_Into_Reg(asm_reg_e, Y_OFFSET(index), adr_of, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { BEFORE_ARG; Load_Mem_Into_Reg("%l2", index * 8, adr_of, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { if (adr_of) { BEFORE_ARG; Load_Mem_Into_Reg("%l3", index * 8, adr_of, r); AFTER_ARG; return 1; } BEFORE_FP_ARG; Load_Mem_Into_Reg("%l3", index * 8, adr_of, r); AFTER_FP_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { delay_active = 0; /* stop the delay, so Delay_Printf is a Delay_Printf */ Delay_Printf("call", UN "%s,0", fct_name); if (!Delay_Flush()) /* emit the delay insn to fill the delay slot */ Delay_Printf("nop", ""); /* else fill it with a nop */ } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { #ifndef MAP_REG_E if (p_inline && INL_ACCESS_INFO(p_inline)) reload_e = 1; #endif } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Delay_Printf("jmp", "%%o0"); Delay_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Delay_Printf("cmp", "%%o0,0"); #if 0 Delay_Printf("be", UN "fail"); Delay_Printf("nop", ""); /* delay slot */ #else Delay_Printf("be", UN "%s+4", "fail"); /* use delay slot */ #ifdef MAP_REG_B Delay_Printf("ldx", "[%s-8],%%o0", asm_reg_b); /* use first insn of Pl_Fail */ #else Delay_Printf("ldx", "%s,%%o0", asm_reg_b); #endif #endif } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { Load_Mem_Base_Into_Reg(name, 0, "%o1"); Store_Reg_Into_Mem("%o0", "%o1", index * 8); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* same as Move_To_Reg_X */ Store_Reg_Into_Mem("%o0", asm_reg_bank, index * 8); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* same as Move_To_Reg_Y */ Store_Reg_Into_Mem("%o0", asm_reg_e, Y_OFFSET(index)); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { Store_Reg_Into_Mem("%o0", "%l2", index * 8); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { Store_Reg_Into_Mem("%f0", "%l3", index * 8); } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { if (OK_FOR_SIMM13(int_val)) Delay_Printf("cmp", "%%o0,%ld", int_val); else { Load_Long_Into_Reg(int_val, "%g1"); Delay_Printf("cmp", "%%o0,%%g1"); } } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Delay_Printf("be", UN "%s", label); Delay_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { Delay_Printf("bg", UN "%s", label); Delay_Printf("nop", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Delay_Printf("ret", ""); Delay_Printf("restore", ""); /* delay slot */ } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { Delay_Printf(".section", ".rodata.str1.8,\"aMS\",@progbits,1"); } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Delay_Printf(".align", "8"); Label_Printf("%s%d:", STRING_PREFIX, str_no); Delay_Printf(".asciz", "%s", asciiz); } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { Delay_Printf(".section", "\".data\""); Delay_Printf(".align", "8"); } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: #ifdef M_sparc64_sunos if (!global) Delay_Printf(".reserve", UN "%s,%ld,\"bss\",8", name, value * 8); else Delay_Printf(".common", UN "%s,%ld,\"bss\"", name, value * 8); #else if (!global) Delay_Printf(".local", UN "%s", name); Delay_Printf(".common", UN "%s,%ld,8", name, value * 8); #endif break; case INITIAL_VALUE: if (global) Delay_Printf(".globl", UN "%s", name); #if defined(M_sparc64_solaris) || defined(M_sparc64_bsd) Delay_Printf(".align", "8", name); Delay_Printf(".type", UN "%s,#object", name); Delay_Printf(".size", UN "%s,8", name); #endif Label_Printf(UN "%s:", name); Delay_Printf(".xword", "%ld", value); break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { if (initializer_fct == NULL) return; Delay_Printf(".section", "\".ctors\",#alloc,#write"); Delay_Printf(".align", "8"); Delay_Printf(".xword", UN "%s", initializer_fct); } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { } /*-------------------------------------------------------------------------* * DELAY_PRINTF * * * *-------------------------------------------------------------------------*/ void Delay_Printf(char *op, char *operands, ...) { va_list arg_ptr; va_start(arg_ptr, operands); if (!delay_active) { /* warning: the delay_op/delay_operands cannot be used (see Call_C_Invoke) */ vsprintf(buff, operands, arg_ptr); Inst_Out(op, buff); } else { if (delay_op) Inst_Out(delay_op, delay_operands); delay_op = op; vsprintf(delay_operands, operands, arg_ptr); } va_end(arg_ptr); } /*-------------------------------------------------------------------------* * DELAY_PRINTF * * * *-------------------------------------------------------------------------*/ int Delay_Flush(void) { if (delay_op == NULL) return 0; Inst_Out(delay_op, delay_operands); delay_op = NULL; return 1; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/alpha_any.c����������������������������������������������������������������0000644�0001750�0001750�00000156760�13021324543�015305� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : alpha_any.c * * Descr.: translation file for Linux/OSF on alpha * * Author: Alexander Diemand, Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <stdio.h> #include <stdarg.h> #include <string.h> /*---------------------------------* * Constants * *---------------------------------*/ #define STRING_PREFIX "$LC" #define MAX_C_ARGS_IN_C_CODE 32 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ char asm_reg_bank[10]; char asm_reg_e[10]; char asm_reg_b[10]; char asm_reg_cp[10]; int w_label = 0; char dbl_arg_buffer[8192] = "\0"; /* a temp buffer for the double arguments */ char act_routine[512] = "\0"; /* remembers the actual routine we are building */ int inPrologCode = 0; /* whether we are currently compiling a prolog code */ /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 0; char *comment_prefix = "#"; char *local_symb_prefix = "$"; int strings_need_null = 1; int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * INLINED CODE * * * *-------------------------------------------------------------------------*/ /* all %s will be replaced with the function's name * all %d will be replaced with the current nb_inlines */ static long nb_inlines = 0; static char *def_inlines[] = { /* name code */ "Put_X_Variable", " # %s inlined\n\ s8addq $10,0,$0 # Make_Self_Ref(H) \n\ or $0,1,$0 \n\ stq $0,0($10) # Global_Push \n\ addq $10,8,$10 \n", "Put_Y_Variable", " # %s inlined\n\ s8addq $16,0,$0 # Make_Self_Ref(y_adr) \n\ or $0,1,$0 \n\ stq $0,0($16) # save in *y_adr \n", "Put_Atom", " # %s inlined\n\ s8addq $16,0,$0 # Tag_ATM(n) \n\ or $0,3,$0 \n", "Put_Integer", " # %s inlined\n\ s8addq $16,0,$0 # Tag_INT(n) \n", "Put_Float", " # %s inlined\n\ s8addq $10,8,$0 # res_word = Tag_FLT(H) \n\ stt $f16,0($10) # Global_Push_Float(n) \n\ or $0,4,$0 \n\ addq $10,8,$10 \n", "Put_Nil", " # %s inlined\n\ lda $0,14131 \n", "Put_List", " # %s inlined\n\ s8addq $10,0,$0 # Tag_LST(H) \n\ stq $31,2056($9) # S = 0 (WriteMode) \n\ or $0,5,$0 \n", "Put_Structure", " # %s inlined\n\ sll $17,0x10,$17 \n\ addl $17,$16,$17 \n\ s8addq $10,0,$0 \n\ or $0,0x6,$0 \n\ stq $17,0($10) \n\ addq $10,0x8,$10 \n\ stq $31,2056($9) \n", "Cut", " # %s inlined\n\ srl $16,3,$11 \n", "Switch_On_Integer", " # %s inlined\n\ ldq $0,0($9) \n\ srl $0,3,$0 \n", "Switch_On_Term", " # %s inlined\n\ ldq $1,0($9) # deref(A(0),word,tag,adr) \n\ mov $1,$2 # word = A(0) \n\ clr $5 # working_adr \n\ %s_1_%d: \n\ and $2,7,$3 # Tag_Of \n\ cmpeq $3,1,$4 # REF? \n\ beq $4,%s_2_%d # no -> break \n\ srl $2,3,$6 # UnTag_REF(word) \n\ cmpeq $5,$6,$4 # working_adr == adr \n\ bne $4,%s_2_%d # yes -> break \n\ ldq $2,0($6) \n\ mov $6,$5 \n\ br %s_1_%d \n\ \n\ %s_2_%d: \n\ stq $2,0($9) # A(0) = word \n\ cmoveq $3,$18,$0 # move c_int to return if tag == (INT = 0)\n\ beq $3,%s_3_%d \n\ subq $3,3,$4 \n\ cmoveq $4,$17,$0 # move c_atm to return if tag == (ATM = 3)\n\ beq $4,%s_3_%d \n\ subq $3,5,$4 \n\ cmoveq $4,$19,$0 # move c_lst to return if tag == (LST = 5)\n\ beq $4,%s_3_%d \n\ subq $3,6,$4 \n\ cmoveq $4,$20,$0 # move c_stc to return if tag == (STC = 6)\n\ beq $4,%s_3_%d \n\ mov $16,$0 # for all the rest \n\ \n\ %s_3_%d: \n\ bne $0,%s_4_%d \n\ ldq $0,-8($11) # return ALTB(B) \n\ %s_4_%d: \n", /* 00000001200d2c40 <Switch_On_Structure>: 1200d2c40: 11 00 bb 27 ldah gp,17(t12) 1200d2c44: 10 2f bd 23 lda gp,12048(gp) 1200d2c48: 00 00 29 a4 ldq t0,0(s0) 1200d2c4c: 19 30 20 42 addl a1,0x1,t11 1200d2c50: 22 97 20 4b sll t11,0x4,t1 1200d2c54: 81 76 20 48 srl t0,0x3,t0 1200d2c58: 04 04 02 42 addq a0,t1,t3 1200d2c5c: 00 00 61 a4 ldq t2,0(t0) 1200d2c60: 18 04 63 44 mov t2,t10 1200d2c64: 28 b9 7d a7 ldq t12,-18136(gp) 1200d2c68: 9e 6b fb 6a jsr t9,(t12),1200cdae4 <Scan_Quoted+0x504> 1200d2c6c: 11 00 b7 27 ldah gp,17(t9) 1200d2c70: e4 2e bd 23 lda gp,12004(gp) 1200d2c74: 1b 00 7f 43 addl t12,zero,t12 1200d2c78: 3b 97 60 4b sll t12,0x4,t12 1200d2c7c: 02 04 1b 42 addq a0,t12,t1 1200d2c80: 08 00 02 a4 ldq v0,8(t1) 1200d2c84: 0a 00 00 e4 beq v0,1200d2cb0 <Switch_On_Structure+0x70> 1200d2c88: 1f 04 ff 47 nop 1200d2c8c: 00 00 e0 2f unop 1200d2c90: 00 00 22 a4 ldq t0,0(t1) 1200d2c94: a1 05 23 40 cmpeq t0,t2,t0 1200d2c98: 05 00 20 f4 bne t0,1200d2cb0 <Switch_On_Structure+0x70> 1200d2c9c: 02 14 42 40 addq t1,0x10,t1 1200d2ca0: a1 05 44 40 cmpeq t1,t3,t0 1200d2ca4: c2 04 30 44 cmovne t0,a0,t1 1200d2ca8: 08 00 02 a4 ldq v0,8(t1) 1200d2cac: f8 ff 1f f4 bne v0,1200d2c90 <Switch_On_Structure+0x50> 1200d2cb0: 01 00 00 f4 bne v0,1200d2cb8 <Switch_On_Structure+0x78> 1200d2cb4: f8 ff 0b a4 ldq v0,-8(s2) 1200d2cb8: 01 80 fa 6b ret zero,(ra),0x1 1200d2cbc: 00 00 e0 2f unop */ /* 00000001200d2ba0 <Switch_On_Atom>: 1200d2ba0: 11 00 bb 27 ldah gp,17(t12) 1200d2ba4: b0 2f bd 23 lda gp,12208(gp) 1200d2ba8: 00 00 29 a4 ldq t0,0(s0) 1200d2bac: 19 30 20 42 addl a1,0x1,t11 1200d2bb0: 22 97 20 4b sll t11,0x4,t1 1200d2bb4: 81 76 20 48 srl t0,0x3,t0 1200d2bb8: 04 04 02 42 addq a0,t1,t3 1200d2bbc: 23 f6 21 48 zapnot t0,0xf,t2 1200d2bc0: 18 04 63 44 mov t2,t10 1200d2bc4: 28 b9 7d a7 ldq t12,-18136(gp) 1200d2bc8: c6 6b fb 6a jsr t9,(t12),1200cdae4 <Scan_Quoted+0x504> 1200d2bcc: 11 00 b7 27 ldah gp,17(t9) 1200d2bd0: 84 2f bd 23 lda gp,12164(gp) 1200d2bd4: 1b 00 7f 43 addl t12,zero,t12 1200d2bd8: 3b 97 60 4b sll t12,0x4,t12 1200d2bdc: 02 04 1b 42 addq a0,t12,t1 1200d2be0: 08 00 02 a4 ldq v0,8(t1) 1200d2be4: 0a 00 00 e4 beq v0,1200d2c10 <Switch_On_Atom+0x70> 1200d2be8: 1f 04 ff 47 nop 1200d2bec: 00 00 e0 2f unop 1200d2bf0: 00 00 22 a4 ldq t0,0(t1) 1200d2bf4: a1 05 23 40 cmpeq t0,t2,t0 1200d2bf8: 05 00 20 f4 bne t0,1200d2c10 <Switch_On_Atom+0x70> 1200d2bfc: 02 14 42 40 addq t1,0x10,t1 1200d2c00: a1 05 44 40 cmpeq t1,t3,t0 1200d2c04: c2 04 30 44 cmovne t0,a0,t1 1200d2c08: 08 00 02 a4 ldq v0,8(t1) 1200d2c0c: f8 ff 1f f4 bne v0,1200d2bf0 <Switch_On_Atom+0x50> 1200d2c10: 01 00 00 f4 bne v0,1200d2c18 <Switch_On_Atom+0x78> 1200d2c14: f8 ff 0b a4 ldq v0,-8(s2) 1200d2c18: 01 80 fa 6b ret zero,(ra),0x1 1200d2c1c: 00 00 e0 2f unop */ "Unify_Variable", " # %s inlined\n\ ldq $0,2056($9) # S == 0 (WriteMode)? \n\ mov $0,$1 \n\ beq $0,%s_1_%d \n\ \n\ # NOT WRITE_MODE \n\ ldq $0,0($1) # word = *S \n\ and $0,7,$2 # tag = Tag_Of(word= *S) \n\ addq $1,8,$1 \n\ stq $1,2056($9) # S++ \n\ \n\ # Make_Copy_Of_Word(tag=$2,word=$0) \n\ cmpeq $2,2,$2 # Dont_Separate_Tag(tag) \n\ beq $2,%s_99_%d # false \n\ \n\ andnot $0,7,$1 # adr=UnTag_Ref(word) \n\ or $1,1,$0 # word=Tag_REF(adr) \n\ \n\ br %s_99_%d \n\ \n\ # WRITE_MODE \n\ %s_1_%d: \n\ s8addq $10,0,$0 # word = Make_Self_Ref(H) \n\ or $0,1,$0 \n\ stq $0,0($10) # Global_Push(word) \n\ addq $10,8,$10 \n\ \n\ %s_99_%d: \n\ # continue \n", "Unify_Void", " # %s inlined\n\ ldq $0,2056($9) # S == 0 (WriteMode)? \n\ mov $0,$1 \n\ beq $0,%s_1_%d \n\ \n\ # NOT WRITE_MODE \n\ s8addq $16,$1,$1 \n\ stq $1,2056($9) # S = S + n \n\ br %s_99_%d \n\ \n\ # WRITE_MODE \n\ %s_1_%d: \n\ s8addq $16,$10,$16 # end_adr = H+n \n\ cmpult $10,$16,$1 \n\ beq $1,%s_99_%d # H < end_adr \n\ %s_2_%d: \n\ s8addq $10,0,$1 \n\ or $1,1,$1 \n\ stq $1,0($10) # ++H \n\ addq $10,8,$10 \n\ cmpult $10,$16,$1 \n\ bne $1,%s_2_%d # H < end_adr \n\ \n\ %s_99_%d: \n\ # continue \n", "Create_Choice_Point", " # %s inlined\n\ cmpule $11,$14,$2 # Local_Top \n\ mov $14,$3 \n\ cmoveq $2,$11,$3 \n\ mov $11,$4 # adr = B \n\ s8addq $17,64,$1 # +CHOICE_STATIC_SIZE+arity \n\ addq $3,$1,$11 # -> B \n\ \n\ stq $16,-8($11) # ALTB(B) = codep_alt \n\ stq $13,-16($11)# CPB(B) = CP \n\ cmpeq $31,$17,$3 # arity == 0? \n\ ldq $1,2072($9) # BCI \n\ stq $1,-24($11) # BCIB(B) = BCI \n\ stq $14,-32($11)# EB(B) = E \n\ stq $4,-40($11) # BB(B) = adr \n\ stq $10,-48($11)# HB(B) = H \n\ stq $12,-56($11)# TRB(B) = TR \n\ clr $2 \n\ ldq $1,2048($9) # CS \n\ lda $4,-9 \n\ stq $1,-64($11) # CSB(B) = CS \n\ bne $3,%s_2_%d # skip \n\ \n\ %s_1_%d: \n\ s8addq $2,$9,$1 \n\ subl $4,$2,$6 \n\ ldq $5,0($1) # A(i) \n\ s8addq $6,$11,$0 \n\ addq $2,1,$2 # i++ \n\ stq $5,0($0) \n\ cmplt $2,$17,$3 # i<arity \n\ bne $3,%s_1_%d \n\ \n\ %s_2_%d: \n\ ldq $1,2064($9) \n\ addq $1,1,$1 \n\ stq $1,2064($9) \n", /* 00000001200d2dc0 <Update_Choice_Point>: 1200d2dc0: 11 00 bb 27 ldah gp,17(t12) 1200d2dc4: 90 2d bd 23 lda gp,11664(gp) 1200d2dc8: 3e 15 c2 43 subq sp,0x10,sp 1200d2dcc: 08 00 fe b5 stq fp,8(sp) 1200d2dd0: 00 00 5e b7 stq ra,0(sp) 1200d2dd4: 0f 04 31 46 mov a1,fp 1200d2dd8: f8 ff 0b b6 stq a0,-8(s2) 1200d2ddc: c8 ff 0b a6 ldq a0,-56(s2) 1200d2de0: 60 b9 7d a7 ldq t12,-18080(gp) 1200d2de4: 46 40 5b 6b jsr ra,(t12),1200d2f00 <Untrail> 1200d2de8: 11 00 ba 27 ldah gp,17(ra) 1200d2dec: 68 2d bd 23 lda gp,11624(gp) 1200d2df0: 04 04 ff 47 clr t3 1200d2df4: e8 ff 4b 8d ldt $f10,-24(s2) 1200d2df8: a1 09 ef 43 cmplt zero,fp,t0 1200d2dfc: f0 ff ab a5 ldq s4,-16(s2) 1200d2e00: 18 08 49 9d stt $f10,2072(s0) 1200d2e04: c0 ff 6b 8d ldt $f11,-64(s2) 1200d2e08: e0 ff cb a5 ldq s5,-32(s2) 1200d2e0c: d0 ff 4b a5 ldq s1,-48(s2) 1200d2e10: 00 08 69 9d stt $f11,2048(s0) 1200d2e14: 0a 00 20 e4 beq t0,1200d2e40 <Update_Choice_Point+0x80> 1200d2e18: f7 ff bf 20 lda t4,-9(zero) 1200d2e1c: 00 00 e0 2f unop 1200d2e20: 21 01 a4 40 subl t4,t3,t0 1200d2e24: 41 06 2b 40 s8addq t0,s2,t0 1200d2e28: 43 06 89 40 s8addq t3,s0,t2 1200d2e2c: 00 00 41 8d ldt $f10,0(t0) 1200d2e30: 04 30 80 40 addl t3,0x1,t3 1200d2e34: a2 09 8f 40 cmplt t3,fp,t1 1200d2e38: 00 00 43 9d stt $f10,0(t2) 1200d2e3c: f8 ff 5f f4 bne t1,1200d2e20 <Update_Choice_Point+0x60> 1200d2e40: 00 00 5e a7 ldq ra,0(sp) 1200d2e44: 08 00 fe a5 ldq fp,8(sp) 1200d2e48: 1e 14 c2 43 addq sp,0x10,sp 1200d2e4c: 01 80 fa 6b ret zero,(ra),0x1 1200d2e50: 1f 04 ff 47 nop */ /* 00000001200d2e60 <Delete_Choice_Point>: 1200d2e60: 11 00 bb 27 ldah gp,17(t12) 1200d2e64: f0 2c bd 23 lda gp,11504(gp) 1200d2e68: 3e 15 c2 43 subq sp,0x10,sp 1200d2e6c: 08 00 fe b5 stq fp,8(sp) 1200d2e70: 00 00 5e b7 stq ra,0(sp) 1200d2e74: 0f 04 10 46 mov a0,fp 1200d2e78: c8 ff 0b a6 ldq a0,-56(s2) 1200d2e7c: 60 b9 7d a7 ldq t12,-18080(gp) 1200d2e80: 1f 40 5b 6b jsr ra,(t12),1200d2f00 <Untrail> 1200d2e84: 11 00 ba 27 ldah gp,17(ra) 1200d2e88: cc 2c bd 23 lda gp,11468(gp) 1200d2e8c: 04 04 ff 47 clr t3 1200d2e90: c0 ff 4b 8d ldt $f10,-64(s2) 1200d2e94: a1 09 ef 43 cmplt zero,fp,t0 1200d2e98: f0 ff ab a5 ldq s4,-16(s2) 1200d2e9c: e0 ff cb a5 ldq s5,-32(s2) 1200d2ea0: d0 ff 4b a5 ldq s1,-48(s2) 1200d2ea4: 00 08 49 9d stt $f10,2048(s0) 1200d2ea8: e8 ff 6b 8d ldt $f11,-24(s2) 1200d2eac: 18 08 69 9d stt $f11,2072(s0) 1200d2eb0: 0b 00 20 e4 beq t0,1200d2ee0 <Delete_Choice_Point+0x80> 1200d2eb4: f7 ff bf 20 lda t4,-9(zero) 1200d2eb8: 1f 04 ff 47 nop 1200d2ebc: 00 00 e0 2f unop 1200d2ec0: 21 01 a4 40 subl t4,t3,t0 1200d2ec4: 41 06 2b 40 s8addq t0,s2,t0 1200d2ec8: 43 06 89 40 s8addq t3,s0,t2 1200d2ecc: 00 00 41 8d ldt $f10,0(t0) 1200d2ed0: 04 30 80 40 addl t3,0x1,t3 1200d2ed4: a2 09 8f 40 cmplt t3,fp,t1 1200d2ed8: 00 00 43 9d stt $f10,0(t2) 1200d2edc: f8 ff 5f f4 bne t1,1200d2ec0 <Delete_Choice_Point+0x60> 1200d2ee0: 10 08 29 a4 ldq t0,2064(s0) 1200d2ee4: d8 ff 6b a5 ldq s2,-40(s2) 1200d2ee8: 21 35 20 40 subq t0,0x1,t0 1200d2eec: 10 08 29 b4 stq t0,2064(s0) 1200d2ef0: 00 00 5e a7 ldq ra,0(sp) 1200d2ef4: 08 00 fe a5 ldq fp,8(sp) 1200d2ef8: 1e 14 c2 43 addq sp,0x10,sp 1200d2efc: 01 80 fa 6b ret zero,(ra),0x1 */ "Allocate", " # %s inlined\n\ cmpule $11,$14,$1 # Local_Top \n\ mov $14,$2 \n\ cmoveq $1,$11,$2 \n\ mov $14,$3 # adr = E \n\ ldq $4,2072($9) # BCIE(E) = BCI \n\ s8addq $16,24,$16 # +ENVIR_STATIC_SIZE+3 \n\ addq $2,$16,$14 # -> E \n\ \n\ stq $13,-8($14) # CPE(E) = CP \n\ #ldq $4,2072($9) # BCIE(E) = BCI \n\ stq $3,-24($14) # EE(E) = adr \n\ stq $4,-16($14) \n", "Deallocate", " # %s inlined\n\ ldq $13,-8($14) # CP=CPE(E) \n\ ldq $1,-16($14) # BCIE(E) \n\ stq $1,2072($9) # BCI=BCIE(E)($1) \n\ ldq $14,-24($14) # E=EE(E) \n", 0, 0 /* end of list */ }; /*-------------------------------------------------------------------------* * MAKE_INLINE * * * *-------------------------------------------------------------------------*/ /* when it finds a function to inline it will do so immediatly and return 1 * else it fails and returns 0 */ static int make_inline(char *fct_name, int nb_args) { char *fp; int counter; /* user can set an environment variable to control this */ if (!getenv("GPROLOG_ASM_INLINE")) return 0; counter = 0; while (def_inlines[counter]) { if (strcmp(fct_name, def_inlines[counter]) == 0) { /* found code to inline, emit */ fp = def_inlines[++counter]; while (*fp != '\0') { if (*fp == '%' && *(fp + 1) == 's') { String_Out(fct_name); fp++; } else if (*fp == '%' && *(fp + 1) == 'd') { Int_Out(nb_inlines); fp++; } else { Char_Out(*fp); } fp++; } nb_inlines++; return 1; } counter++; } return 0; } /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { #ifdef MAP_REG_BANK sprintf(asm_reg_bank, "%s", MAP_REG_BANK); #else strcpy(asm_reg_bank, "$9"); #endif Inst_Printf("# asm_reg_bank ", asm_reg_bank); #ifdef MAP_REG_E sprintf(asm_reg_e, "%s", MAP_REG_E); #else sprintf(asm_reg_e, "%d(%s)", MAP_OFFSET_E, asm_reg_bank); #endif Inst_Printf("# REG_E ", asm_reg_e); #ifdef MAP_REG_B sprintf(asm_reg_b, "%s", MAP_REG_B); #else sprintf(asm_reg_b, "%d(%s)", MAP_OFFSET_B, asm_reg_bank); #endif Inst_Printf("# REG_B ", asm_reg_b); #ifdef MAP_REG_CP sprintf(asm_reg_cp, "%s", MAP_REG_CP); #else sprintf(asm_reg_cp, "%d(%s)", MAP_OFFSET_CP, asm_reg_bank); #endif Inst_Printf("# REG_CP ", asm_reg_cp); Inst_Printf(".set", "noat"); Inst_Printf(".set", "noreorder"); Label_Printf(".text"); } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { /* we are printing the fixed doubles at the end of the file, * they will appear in the data section */ if (dbl_arg_buffer[0] != '\0') { #ifdef M_alpha_linux Label_Printf(".section\t.rodata"); #else Label_Printf(".rdata"); #endif Label_Printf(dbl_arg_buffer); dbl_arg_buffer[0] = '\0'; } } /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { if (act_routine[0] != '\0') Code_Stop(); /* we first have to close the previous code */ Inst_Printf(".align", "5"); if (global) Inst_Printf(".globl", "%s", label); Inst_Printf(".ent", "%s", label); Label(label); /* remember this label */ strcpy(act_routine, label); if (prolog) { /* prolog code does not need any stack space */ inPrologCode = 1; Inst_Printf(".frame", "$30,0,$26,0"); Inst_Printf(".mask", "0x4000000,0"); Inst_Printf("ldgp", "$gp,0($27)"); Inst_Printf(".prologue", "1"); } else { /* for c code we need to save some registers */ inPrologCode = 0; Inst_Printf(".frame", "$30,32,$26,0"); Inst_Printf(".mask", "0x4008000,-32"); Inst_Printf("ldgp", "$gp,0($27)"); Inst_Printf("subq", "$30,32,$30"); Inst_Printf("stq", "$26,0($30)"); Inst_Printf("stq", "$15,8($30)"); Inst_Printf(".prologue", "1"); } } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { Inst_Printf(".end", "%s", act_routine); act_routine[0] = '\0'; } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf("\n%s:", label); } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { #ifdef M_alpha_linux /* also works for OSF but 'as' warns */ Inst_Printf("jmp", "$31,%s", label); /* about macro using $at */ #else Inst_Printf("lda", "$27,%s", label); Inst_Printf("jmp", "$31,($27),%s", label); #endif } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { #ifdef MAP_REG_CP Inst_Printf("lda", "%s,$Lcont%d", asm_reg_cp, w_label); /* CP = $Lcont%d */ #else Inst_Printf("lda", "$4,$Lcont%d", w_label); /* CP = $Lcont%d */ Inst_Printf("stq", "$4,%s", asm_reg_cp); #endif } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf("$Lcont%d:", w_label++); Inst_Printf("ldgp","$gp,0($27)"); } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Prep_CP(); Pl_Jump(label); Here_CP(); } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Inst_Printf("ldq", "$27,-8(%s)", asm_reg_b); #else Inst_Printf("ldq", "$4,%s", asm_reg_b); Inst_Printf("ldq", "$27,-8($4)"); #endif Inst_Printf("jmp", "$31,($27),0"); } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { #ifdef MAP_REG_CP Inst_Printf("mov", "%s,$27", asm_reg_cp); /* make a copy of it in $27 */ #else Inst_Printf("ldq", "$27,%s", asm_reg_cp); #endif Inst_Printf("jmp", "$31,($27),0"); /* jump to CP */ } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { Inst_Printf("lda", "$3,%s", label); Inst_Printf("jmp", "$31,($3),%s", label); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Inst_Printf("ldq", "$1,%d(%s)", 8 * index, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { #ifdef MAP_REG_E Inst_Printf("ldq", "$1,%d(%s)", Y_OFFSET(index), asm_reg_e); #else Inst_Printf("ldq", "$4,%s", asm_reg_e); Inst_Printf("ldq", "$1,%d($4)", Y_OFFSET(index)); #endif } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Inst_Printf("stq", "$1,%d(%s)", 8 * index, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { #ifdef MAP_REG_E Inst_Printf("stq", "$1,%d(%s)", Y_OFFSET(index), asm_reg_e); #else Inst_Printf("ldq", "$4,%s", asm_reg_e); Inst_Printf("stq", "$1,%d($4)", Y_OFFSET(index)); #endif } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { } /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { switch (offset) { case 0: Inst_Printf("lda", "$16,%ld", int_val); break; case 1: Inst_Printf("lda", "$17,%ld", int_val); break; case 2: Inst_Printf("lda", "$18,%ld", int_val); break; case 3: Inst_Printf("lda", "$19,%ld", int_val); break; case 4: Inst_Printf("lda", "$20,%ld", int_val); break; case 5: Inst_Printf("lda", "$21,%ld", int_val); break; default: Inst_Printf("lda", "$1,%ld", int_val); Inst_Printf("stq", "$1,%d($30)", (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { char buf[1024]; sprintf(buf, "\t.align 3\n$LD%d:\n\t.t_floating %1.20e\n", w_label++, dbl_val); strcat(dbl_arg_buffer, buf); Inst_Printf("lda", "$1,$LD%d", (w_label - 1)); switch (offset) { case 0: Inst_Printf("ldt", "$f16,0($1)"); break; case 1: Inst_Printf("ldt", "$f17,0($1)"); break; case 2: Inst_Printf("ldt", "$f18,0($1)"); break; case 3: Inst_Printf("ldt", "$f19,0($1)"); break; case 4: Inst_Printf("ldt", "$f20,0($1)"); break; case 5: Inst_Printf("ldt", "$f21,0($1)"); break; default: Inst_Printf("ldt", "$f1,0($1)"); Inst_Printf("stt", "$f1,%d($30)", (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { switch (offset) { case 0: Inst_Printf("lda", "$16,%s%d", STRING_PREFIX, str_no); break; case 1: Inst_Printf("lda", "$17,%s%d", STRING_PREFIX, str_no); break; case 2: Inst_Printf("lda", "$18,%s%d", STRING_PREFIX, str_no); break; case 3: Inst_Printf("lda", "$19,%s%d", STRING_PREFIX, str_no); break; case 4: Inst_Printf("lda", "$20,%s%d", STRING_PREFIX, str_no); break; case 5: Inst_Printf("lda", "$21,%s%d", STRING_PREFIX, str_no); break; default: Inst_Printf("lda", "$1,%s%d", STRING_PREFIX, str_no); Inst_Printf("stq", "$1,%d($30)", (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$16"); break; case 1: sprintf(dest, "%s", "$17"); break; case 2: sprintf(dest, "%s", "$18"); break; case 3: sprintf(dest, "%s", "$19"); break; case 4: sprintf(dest, "%s", "$20"); break; case 5: sprintf(dest, "%s", "$21"); break; default: sprintf(dest, "%s", "$1"); break; } if (!adr_of) { Inst_Printf("lda", "$2,%s", name); Inst_Printf("ldq", "%s,%d($2)", dest, index * 8); } else { Inst_Printf("lda", "%s,%s+%d", dest, name, index * 8); } if (offset > 5) { Inst_Printf("stq", "%s,%d($30)", dest, (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$16"); break; case 1: sprintf(dest, "%s", "$17"); break; case 2: sprintf(dest, "%s", "$18"); break; case 3: sprintf(dest, "%s", "$19"); break; case 4: sprintf(dest, "%s", "$20"); break; case 5: sprintf(dest, "%s", "$21"); break; default: sprintf(dest, "%s", "$1"); break; } if (!adr_of) { Inst_Printf("ldq", "%s,%d(%s)", dest, index * 8, asm_reg_bank); } else { if (index == 0) { Inst_Printf("mov", "%s,%s", asm_reg_bank, dest); } else { Inst_Printf("lda", "%s,%d(%s)", dest, index * 8, asm_reg_bank); } } if (offset > 5) { Inst_Printf("stq", "%s,%d($30)", dest, (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$16"); break; case 1: sprintf(dest, "%s", "$17"); break; case 2: sprintf(dest, "%s", "$18"); break; case 3: sprintf(dest, "%s", "$19"); break; case 4: sprintf(dest, "%s", "$20"); break; case 5: sprintf(dest, "%s", "$21"); break; default: sprintf(dest, "%s", "$1"); break; } if (!adr_of) { #ifdef MAP_REG_E Inst_Printf("ldq", "%s,%d(%s)", dest, Y_OFFSET(index), asm_reg_e); #else Inst_Printf("ldq", "$4,%s", asm_reg_e); Inst_Printf("ldq", "%s,%d($4)", dest, Y_OFFSET(index)); #endif } else { #ifdef MAP_REG_E Inst_Printf("lda", "%s,%d(%s)", dest, Y_OFFSET(index), asm_reg_e); #else Inst_Printf("ldq", "$4,%s", asm_reg_e); Inst_Printf("lda", "%s,%d($4)", dest, Y_OFFSET(index)); #endif } if (offset > 5) { Inst_Printf("stq", "%s,%d($30)", dest, (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { char dest[8]; switch (offset) { case 0: sprintf(dest, "%s", "$16"); break; case 1: sprintf(dest, "%s", "$17"); break; case 2: sprintf(dest, "%s", "$18"); break; case 3: sprintf(dest, "%s", "$19"); break; case 4: sprintf(dest, "%s", "$20"); break; case 5: sprintf(dest, "%s", "$21"); break; default: sprintf(dest, "%s", "$1"); break; } Inst_Printf("lda", "$2,pl_foreign_long"); if (!adr_of) { Inst_Printf("ldq", "%s,%d($2)", dest, index * 8); } else { Inst_Printf("lda", "%s,%d($2)", dest, index * 8); } if (offset > 5) { Inst_Printf("stq", "%s,%d($30)", dest, (offset - 6) * 8); } return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { char dest[8]; if (adr_of) { switch (offset) { case 0: sprintf(dest, "%s", "$16"); break; case 1: sprintf(dest, "%s", "$17"); break; case 2: sprintf(dest, "%s", "$18"); break; case 3: sprintf(dest, "%s", "$19"); break; case 4: sprintf(dest, "%s", "$20"); break; case 5: sprintf(dest, "%s", "$21"); break; default: sprintf(dest, "%s", "$1"); break; } Inst_Printf("lda", "%s,pl_foreign_double+%d", dest, index * 8); if (offset > 5) { Inst_Printf("stq", "%s,%d($30)", dest, (offset - 6) * 8); } return 1; } else { switch (offset) { case 0: sprintf(dest, "%s", "$f16"); break; case 1: sprintf(dest, "%s", "$f17"); break; case 2: sprintf(dest, "%s", "$f18"); break; case 3: sprintf(dest, "%s", "$f19"); break; case 4: sprintf(dest, "%s", "$f20"); break; case 5: sprintf(dest, "%s", "$f21"); break; default: sprintf(dest, "%s", "$f1"); break; } Inst_Printf("lda", "$1,pl_foreign_double+%d", index * 8); Inst_Printf("ldt", "%s,0($1)", dest); if (offset > 5) { Inst_Printf("stt", "%s,%d($30)", dest, (offset - 6) * 8); } return 1; } } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { if (!make_inline(fct_name, nb_args)) { Inst_Printf("jsr", "$26,%s", fct_name); Inst_Printf("ldgp", "$gp,0($26)"); } } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Inst_Printf("mov", "$0,$27"); Inst_Printf("jmp", "$31,($27),0"); } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Inst_Printf("bne", "$0,$Lcont%d", w_label); Pl_Fail(); Label_Printf("$Lcont%d:", w_label++); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { Inst_Printf("lda", "$1,%s", name); if (index * 8 > 1 << 15) { Inst_Printf("lda", "$2,%d", index * 8); Inst_Printf("addq", "$1,$2,$1"); index = 0; } Inst_Printf("stq", "$0,%d($1)", index * 8); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* same as Move_To_Reg_X */ Inst_Printf("stq", "$0,%d(%s)", index * 8, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* same as Move_To_Reg_Y */ #ifdef MAP_REG_E Inst_Printf("stq", "$0,%d(%s)", Y_OFFSET(index), asm_reg_e); #else Inst_Printf("ldq", "$4,%s", asm_reg_e); Inst_Printf("stq", "$0,%d($4)", Y_OFFSET(index)); #endif } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { Inst_Printf("lda", "$1,pl_foreign_long"); Inst_Printf("stq", "$0,%d($1)", index * 8); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { Inst_Printf("lda", "$1,pl_foreign_double"); Inst_Printf("stt", "$f0,%d($1)", index * 8); } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { Inst_Printf("lda", "$1,%ld", int_val); Inst_Printf("subq", "$0,$1,$1"); } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Inst_Printf("beq", "$1,%s", label); } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { /* this is based on the comparison we did with Cmp_Ret_And_Int */ /* means this is more or less a Jump_If_Not_Equal ! */ Inst_Printf("bgt", "$1,%s", label); } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Inst_Printf("ldq", "$26,0($30)"); Inst_Printf("addq", "$30,32,$30"); Inst_Printf("ret", "$31,($26),1"); } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { #ifdef M_alpha_linux Label_Printf(".section\t.rodata"); #else Label_Printf(".rdata"); #endif } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Label_Printf("%s%d:", STRING_PREFIX, str_no); Inst_Printf(".ascii", "%s", asciiz); } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { #ifdef M_alpha_linux Label_Printf(".section\t.sdata,\"aw\""); #else Label_Printf(".data"); #endif Inst_Printf(".align", "3"); } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: Inst_Printf(".align", "3"); #ifdef M_alpha_linux Label_Printf(".section\t.bss"); #endif if (!global) { #ifdef M_alpha_linux Inst_Printf(".type", "%s,@object", name); Inst_Printf(".size", "%s,%ld", name, value * 8); Inst_Printf(".align", "3"); Label_Printf("%s:", name); Inst_Printf(".zero", "%ld", value * 8); #else Inst_Printf(".lcomm", "%s,%ld", name, value * 8); #endif } else { #ifdef M_alpha_linux Inst_Printf(".comm", "%s,%ld,8", name, value * 8); #else Inst_Printf(".comm", "%s,%ld", name, value * 8); #endif } break; case INITIAL_VALUE: #ifdef M_alpha_linux Label_Printf(".section\t.sdata,\"aw\""); #endif if (global) { Inst_Printf(".globl", "%s", name); Inst_Printf(".align", "3"); #ifdef M_alpha_linux Inst_Printf(".type", "%s,@object", name); Inst_Printf(".size", "%s,8", name); #endif Label_Printf("%s:", name); Inst_Printf(".quad", "%ld", value); } else { Inst_Printf(".align", "3"); #ifdef M_alpha_linux Inst_Printf(".type", "%s,@object", name); Inst_Printf(".size", "%s,8", name); #endif Label_Printf("%s:", name); Inst_Printf(".quad", "%ld", value); } break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { /* last routine has to be closed first */ if (act_routine[0] != '\0') { Inst_Printf("ret", "$31,($26),1"); Inst_Printf(".end", "%s", act_routine); act_routine[0] = '\0'; } if (initializer_fct == NULL) return; Inst_Printf(".section", ".ctors,\"aw\""); Inst_Printf(".quad", "%s", initializer_fct); } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { } ����������������gprolog-1.4.5/src/Ma2Asm/ma_parser.h����������������������������������������������������������������0000644�0001750�0001750�00000007621�13021324543�015316� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : ma_parser.h * * Descr.: parser - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "../EnginePl/pl_long.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef enum { IDENTIFIER = 256, /* not a type but a token */ INTEGER, FLOAT, MEM, /* not a token but a type */ X_REG, Y_REG, FL_ARRAY, FD_ARRAY, STRING } ArgTyp; typedef struct { char *name; int index; } Mem; typedef struct { ArgTyp type; int adr_of; union { char *str_val; /* for string */ PlLong int_val; /* for integer */ double dbl_val; /* for double */ Mem mem; /* for mem */ int index; /* for X() Y() FL() FD() */ } t; } ArgInf; typedef struct { PlLong int_val; char *label; } SwtInf; typedef enum { NONE, ARRAY_SIZE, INITIAL_VALUE } VType; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Parse_Ma_File(char *file_name_in, int comment); void Syntax_Error(char *s); ���������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/chkma.c��������������������������������������������������������������������0000644�0001750�0001750�00000046166�13021324543�014432� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : chkma.c * * Descr.: test file for MA translation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include "../EnginePl/pl_long.h" #ifndef FAST /* see Makefile */ #define FC /* define FC to force arch_dep.h to no use FC */ #endif PlULong pl_max_atom; /* to not need atom.o */ #define IF_NO_FD_FILE //#include "engine_pl.h" #include "../EnginePl/engine.c" #if !defined(FC_USED_TO_COMPILE_CORE) && defined(FAST) /* see Makefile */ #error FAST defined but cannot compile for FC #endif /*---------------------------------* * Constants * *---------------------------------*/ #if 1 #define MA_ARRAY ma_array #define MA_GLOBAL_VAR1 ma_global_var1 #define MA_GLOBAL_VAR2 ma_global_var2 #else #define MA_ARRAY _ma_array #define MA_GLOBAL_VAR1 _ma_global_var1 #define MA_GLOBAL_VAR2 _ma_global_var2 #define MA_LOCAL_VAR2 _ma_local_var2 #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /* these 4 lines are get from foreign_supp.c */ PlLong pl_foreign_long[NB_OF_X_REGS]; double pl_foreign_double[NB_OF_X_REGS]; PlLong *pl_base_fl = pl_foreign_long; /* overwrite var of engine.c */ double *pl_base_fd = pl_foreign_double; /* overwrite var of engine.c */ WamWord stack[4096]; int initialised = 0; PlLong x; PlLong ret; PlLong swt[] = { 0, 4, 15, 4095, 123456, 2456789, -1 }; PlLong i; PlLong MA_ARRAY[5000]; PlLong MA_GLOBAL_VAR1; PlLong MA_GLOBAL_VAR2; PlLong MA_LOCAL_VAR2; /* should not be the same as in check_ma.ma */ #if !defined(NO_USE_REGS) && NB_OF_USED_MACHINE_REGS > 0 static WamWord init_buff_regs[NB_OF_USED_MACHINE_REGS]; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void test_initializer(void); void test_declaration(void); void test_pl_jump_and_pl_ret(void); void ma_test_pl_jump_and_pl_ret(void); void test_pl_call_and_pl_ret_and_pl_fail(void); void ma_test_pl_call_and_pl_ret_and_pl_fail(void); void test_prep_cp_and_here_cp(void); void ma_test_prep_cp_and_here_cp(void); void test_jump_and_c_ret(void); void ma_test_jump_and_c_ret(void); void test_call_c(void); void ma_test_call_c(void); void test_move_x_y(void); void ma_test_move_x_y(void); void test_move_y_x(void); void ma_test_move_y_x(void); void test_arg_int(void); void ma_test_arg_int(void); void test_arg_double(void); void ma_test_arg_double(void); void test_arg_mixed(void); void ma_test_arg_mixed(void); void test_arg_string(void); void ma_test_arg_string(void); void test_arg_mem_l(void); void ma_test_arg_mem_l(void); void test_arg_x(void); void ma_test_arg_x(void); void test_arg_y(void); void ma_test_arg_y(void); void test_arg_fl_array(void); void ma_test_arg_fl_array(void); void test_arg_fd_array(void); void ma_test_arg_fd_array(void); void test_call_c_lot_args(void); void ma_test_call_c_lot_args(void); void test_jump_ret(void); void ma_test_jump_ret(void); void test_fail_ret(void); void ma_test_fail_ret(void); void test_move_ret_mem(void); void ma_test_move_ret_mem(void); void test_move_ret_x(void); void ma_test_move_ret_x(void); void test_move_ret_y(void); void ma_test_move_ret_y(void); void test_move_ret_fl(void); void ma_test_move_ret_fl(void); void test_move_ret_fd(void); void ma_test_move_ret_fd(void); void test_switch_ret(void); void ma_test_switch_ret(void); void (*tbl[]) () = { #if 1 test_initializer, test_declaration, test_pl_jump_and_pl_ret, test_pl_call_and_pl_ret_and_pl_fail, test_prep_cp_and_here_cp, #endif test_jump_and_c_ret, test_call_c, test_move_x_y, test_move_y_x, test_arg_int, test_arg_double, test_arg_mixed, test_arg_string, test_arg_mem_l, test_arg_x, test_arg_y, test_arg_fl_array, test_arg_fd_array, test_call_c_lot_args, test_jump_ret, test_fail_ret, test_move_ret_mem, test_move_ret_x, test_move_ret_y, test_move_ret_fl, test_move_ret_fd, test_switch_ret, NULL }; #define PRINTRET void *adr = _AddressOfReturnAddress(); printf("adr return: %p\n", adr) /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { int i = 0; #if defined(FC_USED_TO_COMPILE_CORE) #ifdef FAST printf("check running with FC (fast call)\n"); #else printf("check running without FC (NO fast call)\n"); #endif #elif !defined(FC_USED_TO_COMPILE_CORE) #ifdef FAST #error FAST defined but cannot compile for FC #endif #else #warning WITH FC #endif #ifdef _WIN32 setbuf(stdout, NULL); setbuf(stderr, NULL); #endif #if 1 pl_foreign_double[0] = 1.2e30; pl_foreign_double[47] = -1.234567; #endif Save_Machine_Regs(init_buff_regs); #ifndef NO_MACHINE_REG_FOR_REG_BANK pl_reg_bank = stack; B = stack + NB_OF_X_REGS + 100; #else B = stack; #endif E = B + 1024; printf("pl_reg_bank=&X(0):%#" PL_FMT_x " B:%#" PL_FMT_x " E:%#" PL_FMT_x " &Y(0):%#" PL_FMT_x "\n", (PlULong) pl_reg_bank, (PlULong) B, (PlULong) E, (PlULong) &Y(E, 0)); printf("stack:%#" PL_FMT_x "\n", (PlULong) stack); // { PlLong *disp_stack(); printf("rsp : %p\n", disp_stack()); } while (tbl[i++]) { printf("test %d: ", i); (*tbl[i - 1]) (); printf("test %d OK\n", i); } Restore_Machine_Regs(init_buff_regs); printf("MA checks suceeded\n"); return 0; } void Init_CP(WamCont p) { CP = Adjust_CP(p); } /* can be called by MA code to print a PlLong */ void Write_Long(PlLong x) { printf("\nValue x: %#" PL_FMT_x "\n", x); } void FC Allocate(int x) /* only to update the register for E */ { } WamCont save_CP; void Save_CP() { //printf("in Save_CP\n"); save_CP = CP; } void Restore_CP() { CP = save_CP; } void error(void) { Restore_Machine_Regs(init_buff_regs); printf("*** ERROR ***\n"); fflush(NULL); exit(1); } void Call_Pl(void (*code) (), int must_succeed) { int ok = Pl_Call_Prolog(code); if (ok != must_succeed) error(); } void Initializer(void) { printf("Inside initializer"); initialised = 1; } void test_initializer(void) { #ifdef _MSC_VER printf("c_code intializer (ignored)...\n"); #else printf("c_code intializer...\n"); if (!initialised) error(); #endif } void Several_Calls() { Save_CP(); } void test_declaration(void) { PlLong *adr = MA_ARRAY + 5000; int i; printf("long local/global ...\n"); if (&MA_GLOBAL_VAR1 >= MA_ARRAY && &MA_GLOBAL_VAR1 < adr) error(); for (i = 0; i < 5000; i++) MA_ARRAY[i] = i; if (MA_GLOBAL_VAR2 != 12345) error(); if (MA_LOCAL_VAR2 != 0) error(); } void test_pl_jump_and_pl_ret(void) { printf("pl_jump/pl_ret...\n"); Call_Pl(ma_test_pl_jump_and_pl_ret, 1); } void test_pl_call_and_pl_ret_and_pl_fail(void) { printf("pl_call/pl_ret/pl_fail...\n"); Call_Pl(ma_test_pl_call_and_pl_ret_and_pl_fail, 0); } #if 1 void test_prep_cp_and_here_cp(void) { printf("prep_cp/here_cp...\n"); Call_Pl(ma_test_prep_cp_and_here_cp, 1); } void test_jump_and_c_ret(void) { printf("jump/c_ret...\n"); ALTB(B) = (WamCont) error; Init_CP(error); ma_test_jump_and_c_ret(); } void test_call_c(void) { printf("call_c(void)...\n"); x = 0; Call_Pl(ma_test_call_c, 1); if (x != 1) error(); } void FC test_call_c1(void) { x++; } void test_move_x_y(void) { printf("move X(i) to Y(j)...\n"); X(0) = 24680; X(10) = 13579; X(255) = 123456789; Y(E, 0) = -1; Y(E, 9) = -1; Y(E, 15) = -1; Call_Pl(ma_test_move_x_y, 1); if (Y(E, 3) != 24680 || Y(E, 0) != 13579 || Y(E, 15) != 123456789) error(); } void test_move_y_x(void) { printf("move Y(i) to X(j)...\n"); Y(E, 0) = 24680; Y(E, 10) = 13579; Y(E, 23) = 123456789; X(0) = -1; X(12) = -1; X(31) = -1; Call_Pl(ma_test_move_y_x, 1); if (X(0) != 24680 || X(31) != 13579 || X(12) != 123456789) error(); } void test_arg_int(void) { printf("call_c(int)...\n"); x = 0; Call_Pl(ma_test_arg_int, 1); if (x != 1) error(); } void FC test_arg_int1(int a, int b, int c, int d) { if (a != 12 || b != -1 || c != 4095 || d != 123456789) error(); x++; } void test_arg_double(void) { printf("call_c(double)...\n"); x = 0; Call_Pl(ma_test_arg_double, 1); if (x != 1) error(); } void FC test_arg_double1(double a, double b, double c, double d, double e, double f) { static double loc_d; loc_d = a + c + f; // check some double alignment if (a != 12.456 || b != -1.3e-102 || c != -3.141593 || d != 12.456 || e != -1.3e-102 || f != -3.141593) error(); x++; } // JAT: rumour that fast call (default on x86_64) allows only 4 params in regs, // no matter what type: new test required void test_arg_mixed(void) { printf("call_c(mixed)...\n"); x = 0; Call_Pl(ma_test_arg_mixed, 1); if (x != 1) error(); } void FC test_arg_mixed1(int ai, double a, double b, int bi, int ci, double c, int di) { #ifdef DEBUG printf("Results: ai %d, a %g, b %g, bi %d, c %g, ci %d, di %d\n", ai, a, b, bi, c, ci, di); #endif if (a != 12.456 || b != -1.3e-102 || c != -3.141593 || ai != -19 || bi != 365 || ci != 987654321 || di != -110101) error(); x++; } void test_arg_string(void) { printf("call_c(string)...\n"); x = 0; Call_Pl(ma_test_arg_string, 1); if (x != 1) error(); } void FC test_arg_string1(char *a, char *b) { #ifdef DEBUG printf("b:<%s>\n", a); printf("a:<%s>\n", b); #endif if (strcmp(a, "a string") || strcmp(b, "abcd\01489d\37711ef\n\r")) error(); x++; } void test_arg_mem_l(void) { printf("call_c(mem,&label,mem(...),&mem(...))...\n"); x = 0; Call_Pl(ma_test_arg_mem_l, 1); if (x != 1) error(); } void FC test_arg_mem_l1(PlLong a, PlLong b, PlLong *c, PlLong d, PlLong e, PlLong *f) { // JAT: needed more detail here #ifdef DEBUG printf("Results: a %" PL_FMT_d ", b %" PL_FMT_d ", c %p (test_arg_m_l %p), d %" PL_FMT_d " (MA_ARRAY[0] %" PL_FMT_d "), e %" PL_FMT_d " (MA_ARRAY[4097] %" PL_FMT_d "), f %p (&MA_ARRAY[4500] %p)\n", a,b,c,test_arg_mem_l,d,MA_ARRAY[0],e,MA_ARRAY[4097],f,&MA_ARRAY[4500]); #endif if (a != 128 || b != 12345 || c != (PlLong *) test_arg_mem_l || d != MA_ARRAY[0] || e != MA_ARRAY[4097] || f != &MA_ARRAY[4500]) error(); x++; } void test_arg_x(void) { printf("call_c(X())...\n"); x = 0; X(0) = 123987; X(255) = 987654321; Call_Pl(ma_test_arg_x, 1); if (x != 1) error(); } void FC test_arg_x1(WamWord a, WamWord *b, WamWord c, WamWord *d) { if (a != 123987 || b != &X(0) || c != 987654321 || d != &X(128)) error(); x++; } void test_arg_y(void) { printf("call_c(Y())...\n"); x = 0; Y(E, 0) = 1928374; Y(E, 12) = 456789; Call_Pl(ma_test_arg_y, 1); if (x != 1) error(); } void FC test_arg_y1(WamWord a, WamWord *b, WamWord c, WamWord *d) { if (a != 1928374 || b != &Y(E, 0) || c != 456789 || d != &Y(E, 6)) error(); x++; } void test_arg_fl_array(void) { printf("call_c(FL())...\n"); x = 0; pl_foreign_long[0] = 12; pl_foreign_long[10] = 14; Call_Pl(ma_test_arg_fl_array, 1); if (x != 1) error(); } void FC test_arg_fl_array1(PlLong a, PlLong b, PlLong *c, PlLong *d) { #ifdef DEBUG printf("a=%d b=%d c=%x e=%x (fl=%x fl+56=%x)\n", a, b, c, d, pl_foreign_long, pl_foreign_long + 56); #endif if (a != 12 || b != 14 || c != pl_foreign_long || d != pl_foreign_long + 56) error(); x++; } void test_arg_fd_array(void) { printf("call_c(FD())...\n"); x = 0; pl_foreign_double[0] = 1.2e30; pl_foreign_double[47] = -1.234567; Call_Pl(ma_test_arg_fd_array, 1); if (x != 1) error(); } void FC test_arg_fd_array1(double a, double b, double *c, double *d) { if (a != 1.2e30 || b != -1.234567 || c != pl_foreign_double || d != pl_foreign_double + 127) error(); x++; } void test_call_c_lot_args(void) { printf("call_c(lot_of_args)...\n"); x = 0; X(0) = 123987; X(255) = 987654321; Y(E, 0) = 1928374; Y(E, 12) = 456789; //#ifndef M_powerpc_linux Call_Pl(ma_test_call_c_lot_args, 1); if (x != 1) error(); //#endif } void FC test_call_c_lot_args1(WamWord n0, WamWord n1, WamWord n2, WamWord n3, WamWord n4, WamWord n5, void (*a) (), PlLong b, int c, int d, double e, char *f, WamWord g, WamWord *h, WamWord i, WamWord *j, WamWord k, WamWord *l, WamWord m, WamWord *n, double o) { if (n0 != 0 || n1 != 0 || n2 != 0 || n3 != 0 || n4 != 0 || n5 != 0 || a != test_call_c_lot_args || b != 128 || c != 4095 || d != 123456789 || e != -3.141593 || strcmp(f, "abcd\01489def\n\r") || g != 123987 || h != &X(0) || i != 987654321 || j != &X(128) || k != 1928374 || l != &Y(E, 0) || m != 456789 || n != &Y(E, 6) || o != 1.23456) error(); x++; } void test_jump_ret(void) { printf("call_c()+jump_ret...\n"); x = 0; Call_Pl(ma_test_jump_ret, 1); if (x != 2) error(); } PlLong FC test_jump_ret1(PlLong addr) { #ifdef DEBUG extern void ma_test_jump_ret1(); printf("%x %x\n", addr, ma_test_jump_ret1); #endif x++; return addr; } void FC test_jump_ret2(void) { #ifdef DEBUG printf("in test jump_ret2\n"); #endif x++; } void test_fail_ret(void) { printf("call_c()+fail_ret...\n"); x = 0; ret = 1; Call_Pl(ma_test_fail_ret, 1); if (x != 1) error(); ret = 0; Call_Pl(ma_test_fail_ret, 0); } int FC test_fail_ret1(void) { x++; return ret; } void test_move_ret_mem(void) { printf("call_c()+move_ret mem...\n"); x = 0; Call_Pl(ma_test_move_ret_mem, 1); if (x != 3) error(); if (MA_GLOBAL_VAR1 != 123456789 || MA_ARRAY[64] != 123456789 || MA_ARRAY[4097] != 123456789) error(); } PlLong FC test_move_ret_mem1(void) { x++; return 123456789; } void test_move_ret_x(void) { printf("call_c()+move_ret X()...\n"); x = 0; X(0) = -1; X(255) = -1; Call_Pl(ma_test_move_ret_x, 1); if (x != 2) error(); if (X(0) != 1234987 || X(255) != 45678) error(); } PlLong FC test_move_ret_x1(void) { x++; return (x == 1) ? 1234987 : 45678; } void test_move_ret_y(void) { printf("call_c()+move_ret Y()...\n"); x = 0; Y(E, 0) = -1; Y(E, 11) = -1; Call_Pl(ma_test_move_ret_y, 1); if (x != 2) error(); if (Y(E, 0) != 1234987 || Y(E, 11) != 45678) error(); } PlLong FC test_move_ret_y1(void) { x++; return (x == 1) ? 1234987 : 45678; } void test_move_ret_fl(void) { printf("call_c()+move_ret FL()...\n"); x = 0; pl_foreign_long[0] = -1; pl_foreign_long[11] = -1; Call_Pl(ma_test_move_ret_fl, 1); if (x != 2) error(); if (pl_foreign_long[0] != 1234987 || pl_foreign_long[11] != 45678) error(); } PlLong FC test_move_ret_fl1(void) { x++; return (x == 1) ? 1234987 : 45678; } void test_move_ret_fd(void) { printf("call_c()+move_ret FD()...\n"); x = 0; pl_foreign_double[0] = -1.0; pl_foreign_double[11] = -1; Call_Pl(ma_test_move_ret_fd, 1); if (x != 2) error(); if (pl_foreign_double[0] != 1.234987 || pl_foreign_double[11] != -3.141593) error(); } double FC test_move_ret_fd1(void) { x++; return (x == 1) ? 1.234987 : -3.141593; } void test_switch_ret(void) { printf("call_c()+switch_ret...\n"); ALTB(B) = (WamCont) error; for (i = 0; swt[i] >= 0; i++) Call_Pl(ma_test_switch_ret, 1); Call_Pl(ma_test_switch_ret, 0); /* here swt[i]= -1 switch should fail */ } PlLong FC test_switch_ret1(void) { return swt[i]; } void FC test_switch_ret2(int k) { if (k != i) error(); } #endif /*--- dummy functions needed by engine.c ---*/ void Pl_Init_Atom(void) { } void Pl_Init_Oper(void) { } void Pl_Init_Pred(void) { } void Pl_Init_Machine(void) { } void Pl_Find_Linked_Objects(void) { } void Pl_Fd_Init_Engine(void) { } int Pl_Create_Atom(char *name) { return 1; } PredInf * FC Pl_Lookup_Pred(int module, int func, int arity) { return NULL; } void Pl_Allocate_Stacks(void) { } AtomInf *pl_atom_tbl; int pl_atom_system; void FC Pl_Create_Choice_Point(CodePtr codep_alt, int arity) { } void Pl_Fd_Init_Solver(void) { } void Pl_Fd_Reset_Solver(void) { } void SIGSEGV_Handler(void) { } int Is_Win32_SEGV(void *exp) { return 0; } #ifdef USE_SEH /* (defined(_WIN32) || defined(__CYGWIN__)) && !defined(M_x86_64)*/ EXCEPT_DISPOSITION Win32_SEH_Handler(EXCEPTION_RECORD *excp_rec, void *establisher_frame, CONTEXT *context_rec, void *dispatcher_cxt) { return 0; } #endif void Pl_Fatal_Error(char *format, ...) { } void * Pl_Dummy_Ptr(void *p) { return p; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/ma_parser.c����������������������������������������������������������������0000644�0001750�0001750�00000044221�13021324543�015306� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : ma_parser.c * * Descr.: mini-assembler parser * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <string.h> #include <ctype.h> #include <setjmp.h> #define MA_PARSER_FILE #include "ma_parser.h" #include "ma_protos.h" /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_LINE_LEN 65536 #define MAX_STR_LEN 32768 #define MAX_ARGS 128 #define MAX_SWITCH_CASES 65536 enum { PL_CODE, PL_JUMP, PREP_CP, HERE_CP, PL_CALL, PL_FAIL, PL_RET, JUMP, MOVE, CALL_C, JUMP_RET, FAIL_RET, MOVE_RET, SWITCH_RET, C_CODE, C_RET, LONG }; /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ int needs_pre_pass; /* can be overwritten by mappers */ char *inst[] = { "pl_code", "pl_jump", "prep_cp", "here_cp", "pl_call", "pl_fail", "pl_ret", "jump", "move", "call_c", "jump_ret", "fail_ret", "move_ret", "switch_ret", "c_code", "c_ret", "long", NULL }; int reload_e; int inside_code; char fct_name[MAX_STR_LEN]; int fc; int nb_args; int nb_args_in_words; /* args counted in words (e.g. 32 bits) */ ArgInf arg[MAX_ARGS]; int nb_swt; SwtInf swt[MAX_SWITCH_CASES]; jmp_buf jumper; /* scanner variables */ int keep_source_lines; FILE *file_in; int cur_line_no; char cur_line_str[MAX_LINE_LEN]; char *cur_line_p; char *beg_last_token; char str_val[MAX_STR_LEN]; PlLong int_val; double dbl_val; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Parser(int pass_no, int nb_passes); static int Read_If_Global(int initializer); static void Read_Function(void); static void Read_Switch(void); static int Read_Index(void); static int Read_Optional_Index(void); static int Read_Token(int what); static int Scanner(void); /*-------------------------------------------------------------------------* * PARSE_MA_FILE * * * *-------------------------------------------------------------------------*/ int Parse_Ma_File(char *file_name_in, int comment) { int ret_val; int i, nb_passes = needs_pre_pass + 1; if (file_name_in == NULL) { file_name_in = "stdin"; file_in = stdin; } else if ((file_in = fopen(file_name_in, "rt")) == NULL) { fprintf(stderr, "cannot open input file %s\n", file_name_in); return 0; } for(i = 1; i <= nb_passes; i++) { if (i == 2 && fseek(file_in, 0, SEEK_SET) == -1) { fprintf(stderr, "cannot reposition file %s (needed for 2 passes)\n", file_name_in); return 0; } keep_source_lines = comment; if ((ret_val = setjmp(jumper)) == 0) Parser(i, nb_passes); if (ret_val != 0) return 0; } if (file_in != stdin) fclose(file_in); return 1; } /*-------------------------------------------------------------------------* * PARSER * * * *-------------------------------------------------------------------------*/ #define Pre_Pass() (pass_no < nb_passes) #define Stop_Previous_Code() \ { \ if (!Pre_Pass() && inside_code) \ { \ Code_Stop(); \ inside_code = 0; \ } \ } static void Parser(int pass_no, int nb_passes) { int init_already_read = 0; char **in, *name; int k, i; int global; if (Pre_Pass()) keep_source_lines = 0; cur_line_p = cur_line_str; cur_line_str[0] = '\0'; cur_line_no = 0; for (;;) { k = Scanner(); if (k == 0) /* end of file */ break; if (k != IDENTIFIER) Syntax_Error("miniasm declaration or instruction expected"); for (in = inst; *in; in++) if (strcmp(str_val, *in) == 0) break; k = in - inst; /* ignore it in Pre_Pass() or long decl if Pre_Pass() done before */ if ((Pre_Pass() && k != PL_CODE && k != C_CODE && k != LONG && *in != NULL) || (pass_no > 1 && k == LONG)) { *cur_line_p = '\0'; /* skip rest of line */ continue; } switch (k) { case PL_CODE: Stop_Previous_Code(); global = Read_If_Global(0); Read_Token(IDENTIFIER); if (Pre_Pass()) Decl_Code(strdup(str_val), 1, global); else { Code_Start(str_val, 1, global); reload_e = 1; inside_code = 1; } break; case PL_JUMP: Read_Token(IDENTIFIER); Pl_Jump(str_val); reload_e = 1; break; case PREP_CP: Prep_CP(); break; case HERE_CP: Here_CP(); break; case PL_CALL: Read_Token(IDENTIFIER); Pl_Call(str_val); reload_e = 1; break; case PL_FAIL: Pl_Fail(); reload_e = 1; break; case PL_RET: Pl_Ret(); reload_e = 1; break; case JUMP: Read_Token(IDENTIFIER); Jump(str_val); reload_e = 1; break; case MOVE: k = Read_Token(X_REG); i = Read_Index(); if (k == X_REG) Move_From_Reg_X(i); else Move_From_Reg_Y(i); Read_Token(','); k = Read_Token(X_REG); i = Read_Index(); if (k == X_REG) Move_To_Reg_X(i); else Move_To_Reg_Y(i); break; case CALL_C: Read_Function(); Call_C(fct_name, fc, nb_args, nb_args_in_words, arg); break; case JUMP_RET: Jump_Ret(); reload_e = 1; break; case FAIL_RET: Fail_Ret(); break; case MOVE_RET: switch ((k = Scanner())) { case IDENTIFIER: Move_Ret_To_Mem_L(str_val, Read_Optional_Index()); break; case X_REG: Move_Ret_To_Reg_X(Read_Index()); break; case Y_REG: Move_Ret_To_Reg_Y(Read_Index()); break; case FL_ARRAY: Move_Ret_To_Foreign_L(Read_Index()); break; case FD_ARRAY: Move_Ret_To_Foreign_D(Read_Index()); break; default: Syntax_Error("identifier, X(...), Y(...), FL(...) or FD(...) expected"); break; } break; case SWITCH_RET: Read_Switch(); Switch_Ret(nb_swt, swt); break; case C_CODE: Stop_Previous_Code(); global = Read_If_Global(!init_already_read); Read_Token(IDENTIFIER); if (global == 2) { init_already_read = 1; global = 0; if (!Pre_Pass()) Declare_Initializer(strdup(str_val)); } if (Pre_Pass()) Decl_Code(strdup(str_val), 0, global); else { Code_Start(str_val, 0, global); inside_code = 1; } break; case C_RET: C_Ret(); break; case LONG: Stop_Previous_Code(); global = Read_If_Global(1); Read_Token(IDENTIFIER); name = strdup(str_val); if ((i = Read_Optional_Index()) > 0) /* array */ { Decl_Long(name, global, ARRAY_SIZE, i); break; } while (isspace(*cur_line_p)) cur_line_p++; if (*cur_line_p != '=') { Decl_Long(name, global, NONE, 1); /* default: NONE as value = 1 (value = array size = 1) */ break; } cur_line_p++; /* skip the = */ Read_Token(INTEGER); Decl_Long(name, global, INITIAL_VALUE, int_val); break; default: if (*in == NULL) { Read_Token(':'); if (Pre_Pass()) Decl_Code(strdup(str_val), 1, global); else Label(str_val); } } } } /*-------------------------------------------------------------------------* * READ_IF_GLOBAL * * * *-------------------------------------------------------------------------*/ static int Read_If_Global(int initializer) { if (Scanner() != IDENTIFIER) goto err; if (strcmp(str_val, "local") == 0) return 0; if (strcmp(str_val, "global") == 0) return 1; if (initializer && strcmp(str_val, "initializer") == 0) return 2; err: if (!initializer) Syntax_Error("local / global expected"); else Syntax_Error("local / global / initializer expected"); return 0; } /*-------------------------------------------------------------------------* * READ_FUNCTION * * * *-------------------------------------------------------------------------*/ static void Read_Function(void) { int k; fc = 0; Read_Token(IDENTIFIER); if (strcmp(str_val, "fast") == 0) { fc = 1; Read_Token(IDENTIFIER); } strcpy(fct_name, str_val); nb_args = 0; nb_args_in_words = 0; Read_Token('('); k = Scanner(); if (k == ')') return; for (;;) { arg[nb_args].type = k; arg[nb_args].adr_of = 0; one_arg: switch (k) { case '&': k = Scanner(); if (k != IDENTIFIER && k != X_REG && k != Y_REG && k != FL_ARRAY && k != FD_ARRAY) Syntax_Error("identifier, X(...), Y(...), FL(...) or FD(...) expected"); arg[nb_args].type = k; arg[nb_args].adr_of = 1; goto one_arg; case STRING: arg[nb_args].t.str_val = strdup(str_val); break; case INTEGER: arg[nb_args].t.int_val = int_val; break; case FLOAT: nb_args_in_words++; /* double count 1 word more */ arg[nb_args].t.dbl_val = dbl_val; break; case IDENTIFIER: arg[nb_args].type = MEM; arg[nb_args].t.mem.name = strdup(str_val); arg[nb_args].t.mem.index = Read_Optional_Index(); break; case FD_ARRAY: if (arg[nb_args].adr_of == 0) nb_args_in_words++; /* double count 1 word more */ case FL_ARRAY: case X_REG: case Y_REG: arg[nb_args].t.index = Read_Index(); break; } k = Scanner(); nb_args++; nb_args_in_words++; if (k == ')') break; if (k != ',') Syntax_Error(") or , expected"); k = Scanner(); } } /*-------------------------------------------------------------------------* * READ_SWITCH * * * *-------------------------------------------------------------------------*/ static void Read_Switch(void) { int k; Read_Token('('); nb_swt = 0; for (;;) { if (Scanner() != INTEGER) Syntax_Error("integer expected"); Read_Token('='); Read_Token(IDENTIFIER); swt[nb_swt].int_val = int_val; swt[nb_swt].label = strdup(str_val); nb_swt++; k = Scanner(); if (k == ')') break; if (k != ',') Syntax_Error(") or , expected"); } } /*-------------------------------------------------------------------------* * READ_INDEX * * * *-------------------------------------------------------------------------*/ static int Read_Index(void) { Read_Token('('); Read_Token(INTEGER); Read_Token(')'); return int_val; } /*-------------------------------------------------------------------------* * READ_OPTIONAL_INDEX * * * *-------------------------------------------------------------------------*/ static int Read_Optional_Index(void) { return (*cur_line_p == '(') ? Read_Index() : 0; } /*-------------------------------------------------------------------------* * PL_READ_TOKEN * * * *-------------------------------------------------------------------------*/ static int Read_Token(int what) { char str[80]; int k; k = Scanner(); if (k == what || (what == X_REG && k == Y_REG) || (what == FL_ARRAY && k == FD_ARRAY)) return k; switch (what) { case IDENTIFIER: Syntax_Error("identifier expected"); break; case STRING: Syntax_Error("string expected"); break; case INTEGER: Syntax_Error("integer expected"); break; case FLOAT: Syntax_Error("float expected"); break; case X_REG: Syntax_Error("X(...) or Y(...) expected"); break; case FL_ARRAY: Syntax_Error("FL(...) or FD(...) expected"); break; default: sprintf(str, "%c expected", what); Syntax_Error(str); break; } return k; /* for the compiler */ } /*-------------------------------------------------------------------------* * SCANNER * * * *-------------------------------------------------------------------------*/ static int Scanner(void) { char *p, *p1; PlLong i; double d; double strtod(); for (;;) { while (isspace(*cur_line_p)) cur_line_p++; if (*cur_line_p != '\0' && *cur_line_p != ';') break; if (fgets(cur_line_str, sizeof(cur_line_str), file_in)) /* to avoid gcc warning warn_unused_result */ { } if (feof(file_in)) return 0; cur_line_no++; cur_line_p = cur_line_str; if (keep_source_lines) { while (isspace(*cur_line_p)) cur_line_p++; if (*cur_line_p) { p = cur_line_p + strlen(cur_line_p) - 1; if (*p == '\n') *p = '\0'; Label_Printf("\t%s %6d: %s", comment_prefix, cur_line_no, cur_line_p); } } } beg_last_token = cur_line_p; if (*cur_line_p == '"') /* string */ { p = str_val; *p++ = '"'; cur_line_p++; while (*cur_line_p != '"') { if ((*p++ = *cur_line_p++) == '\\') *p++ = *cur_line_p++; } cur_line_p++; if (strings_need_null) { *p++ = '\\'; *p++ = '0'; } *p++ = '"'; *p = '\0'; return STRING; } if (isalpha(*cur_line_p) || *cur_line_p == '_') /* identifier */ { p = str_val; while (isalnum(*cur_line_p) || *cur_line_p == '_') *p++ = *cur_line_p++; *p = '\0'; if (str_val[0] == 'X' && str_val[1] == '\0' && *cur_line_p == '(') return X_REG; if (str_val[0] == 'Y' && str_val[1] == '\0' && *cur_line_p == '(') { if (reload_e) { Reload_E_In_Register(); reload_e = 0; } return Y_REG; } if (strcmp(str_val, "FL") == 0 && *cur_line_p == '(') return FL_ARRAY; if (strcmp(str_val, "FD") == 0 && *cur_line_p == '(') return FD_ARRAY; return IDENTIFIER; } i = Str_To_PlLong(cur_line_p, &p, 0); if (p == cur_line_p) /* not an integer return that character */ return *cur_line_p++; d = strtod(cur_line_p, &p1); if (p1 == p) /* integer */ { int_val = i; cur_line_p = p; return INTEGER; } /* float */ dbl_val = d; cur_line_p = p1; return FLOAT; } /*-------------------------------------------------------------------------* * PL_SYNTAX_ERROR * * * *-------------------------------------------------------------------------*/ void Syntax_Error(char *s) { char *p = cur_line_str + strlen(cur_line_str) - 1; if (*p == '\n') *p = '\0'; fprintf(stderr, "line %d: %s\n", cur_line_no, s); fprintf(stderr, "%s\n", cur_line_str); for (p = cur_line_str; p < beg_last_token; p++) if (!isspace(*p)) *p = ' '; *p = '\0'; fprintf(stderr, "%s^ here\n", cur_line_str); longjmp(jumper, 1); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/ma2asm_inst.c��������������������������������������������������������������0000644�0001750�0001750�00000007121�13021324543�015550� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : ma2asm_inst.c * * Descr.: translation file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define MAPPER_FILE #include "ma_parser.h" #include "ma_protos.h" #include "../EnginePl/gp_config.h" #include "../EnginePl/wam_regs.h" #define FRAMES_ONLY #include "../EnginePl/wam_inst.h" #include "../EnginePl/machine.h" #include "../EnginePl/pl_params.h" #include "../EnginePl/obj_chain.h" #define Y_OFFSET(index) ((- ENVIR_STATIC_SIZE - 1 - index) * sizeof(PlLong)) #if 0 /* to force the inclusion of a mapper */ #define M_ix86_darwin #include "ix86_any.c" #else /* include machine-dependent mapper file */ #if defined(M_ix86) #include "ix86_any.c" #elif defined(M_sparc) #include "sparc_any.c" #elif defined(M_sparc64) #include "sparc64_any.c" #elif defined(M_alpha) #include "alpha_any.c" #elif defined(M_mips_irix) #include "mips_irix.c" #elif defined(M_powerpc) #include "powerpc_any.c" #elif defined(M_x86_64) #include "x86_64_any.c" #endif #endif �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/Makefile.in����������������������������������������������������������������0000644�0001750�0001750�00000004144�13021324543�015236� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GPLC = @GPLC@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ LDLIBS = @LDLIBS@ all: ma2asm@EXE_SUFFIX@ ma_parser@OBJ_SUFFIX@: ma_parser.c ma_parser.h ma_protos.h $(CC) $(CFLAGS) -c ma_parser.c ma2asm@OBJ_SUFFIX@: ma2asm.c ma_protos.h ma_parser.h ../Wam2Ma/bt_string.c \ ../TopComp/copying.c $(CC) $(CFLAGS) -c ma2asm.c ma2asm_inst@OBJ_SUFFIX@: ma2asm_inst.c ma_parser.h ../EnginePl/wam_regs.h \ ix86_any.c powerpc_any.c sparc_any.c sparc64_any.c \ mips_irix.c alpha_any.c x86_64_any.c $(CC) $(CFLAGS) -c ma2asm_inst.c ma2asm@EXE_SUFFIX@: ma2asm@OBJ_SUFFIX@ ma_parser@OBJ_SUFFIX@ \ ma2asm_inst@OBJ_SUFFIX@ ma2asm_inst.c $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@ma2asm@EXE_SUFFIX@ ma2asm@OBJ_SUFFIX@ ma2asm_inst@OBJ_SUFFIX@ ma_parser@OBJ_SUFFIX@ clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp ma2asm@EXE_SUFFIX@ distclean: clean clean-chkma clean-extract_asm # for extract_asm extract_asm@EXE_SUFFIX@: extract_asm.c $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@extract_asm@EXE_SUFFIX@ extract_asm.c clean-extract_asm: rm -f extract_asm@EXE_SUFFIX@ check: chkma@EXE_SUFFIX@ @./chkma@EXE_SUFFIX@ clean-check: clean-chkma # for chkma CHKMA_OBJS=chkma@OBJ_SUFFIX@ chkma_ma@OBJ_SUFFIX@ ../EnginePl/engine1@OBJ_SUFFIX@ # use make FC=Y chkma to generate an fc check chkma@OBJ_SUFFIX@: chkma.c ../EnginePl/engine.c if [ "$$FC" = "Y" ]; then FCFLAGS='-DFAST'; fi; \ $(GPLC) --c-compiler "$(CC)" -C "$(CFLAGS) $$FCFLAGS" -c chkma.c chkma_ma@ASM_SUFFIX@: chkma_ma.ma ma2asm@EXE_SUFFIX@ if [ "$$FC" != "Y" ]; then MAFLAGS='--ignore-fast'; fi; \ ./ma2asm --comment $$MAFLAGS chkma_ma.ma chkma_ma@OBJ_SUFFIX@: chkma_ma@ASM_SUFFIX@ $(GPLC) -c chkma_ma@ASM_SUFFIX@ chkma@EXE_SUFFIX@: $(CHKMA_OBJS) $(GPLC) -o chkma@EXE_SUFFIX@ $(CHKMA_OBJS) --no-pl-lib clean-chkma: rm -f chkma@OBJ_SUFFIX@ chkma_ma@ASM_SUFFIX@ chkma_ma@OBJ_SUFFIX@ chkma@EXE_SUFFIX@ # for test t.wam: t.pl $(GPLC) -W t.pl t.ma: t.wam $(GPLC) -M --comment t.wam t@ASM_SUFFIX@: t.ma $(GPLC) -S --comment t.ma t@EXE_SUFFIX@: t@ASM_SUFFIX@ $(GPLC) -o t@EXE_SUFFIX@ t@ASM_SUFFIX@ --no-fd-lib ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/powerpc_any.c��������������������������������������������������������������0000644�0001750�0001750�00000073602�13021324543�015670� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : powerpc_any.c * * Descr.: translation file for Linux/Darwin (MacOsX) on PowerPC * * Author: Daniel Diaz and Lindsey Spratt * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> /*---------------------------------* * Constants * *---------------------------------*/ #define STRING_PREFIX ".LC" #define DOUBLE_PREFIX ".LCD" #define MAX_C_ARGS_IN_C_CODE 32 #define MAX_DOUBLES_IN_PRED 2048 #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) #define UN #define R(reg) #reg #define F(reg) #reg #define CR(reg) #reg #define HI(adr) #adr "@ha" #define HI_UN(adr) UN #adr "@ha" #define LO(adr) #adr "@l" #define LO_UN(adr) UN #adr "@l" #else #define UN "_" #define R(reg) "r" #reg #define F(reg) "f" #reg #define CR(reg) "cr" #reg #define HI(adr) "ha16(" #adr ")" #define HI_UN(adr) "ha16(" UN #adr ")" #define LO(adr) "lo16(" #adr ")" #define LO_UN(adr) "lo16(" UN #adr ")" #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ double dbl_tbl[MAX_DOUBLES_IN_PRED]; int nb_dbl = 0; int dbl_lc_no = 0; int dbl_reg_no; char asm_reg_bank[20]; char asm_reg_e[20]; char asm_reg_b[20]; char asm_reg_cp[20]; int w_label = 0; /* variables for ma_parser.c / ma2asm.c */ int can_produce_pic_code = 0; char *comment_prefix = "#"; char *local_symb_prefix = ".L"; int strings_need_null = 0; int call_c_reverse_args = 0; char *inline_asm_data[] = { NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define LITTLE_INT(int_val) ((unsigned) ((int_val) + 32768) < 65536) #define IHI(x) ((unsigned) ((unsigned long) x >> 16)) #define ILO(x) ((unsigned) ((unsigned long) x & 0xFFFF)) /*-------------------------------------------------------------------------* * ASM_START * * * *-------------------------------------------------------------------------*/ void Asm_Start(void) { #ifdef MAP_REG_BANK sprintf(asm_reg_bank, R(%s), MAP_REG_BANK); #else strcpy(asm_reg_bank, R(15)); #endif #ifdef MAP_REG_E sprintf(asm_reg_e, R(%s), MAP_REG_E); #else strcpy(asm_reg_e, R(16)); #endif #ifdef MAP_REG_B sprintf(asm_reg_b, R(%s), MAP_REG_B); #else sprintf(asm_reg_b, "%d(%s)", MAP_OFFSET_B, asm_reg_bank); #endif #ifdef MAP_REG_CP sprintf(asm_reg_cp, R(%s), MAP_REG_CP); #else sprintf(asm_reg_cp, "%d(%s)", MAP_OFFSET_CP, asm_reg_bank); #endif Label_Printf(".text"); Label("fail"); Pl_Fail(); } /*-------------------------------------------------------------------------* * ASM_STOP * * * *-------------------------------------------------------------------------*/ void Asm_Stop(void) { #ifdef __ELF__ Inst_Printf(".section", ".note.GNU-stack,\"\",@progbits"); #endif } /*-------------------------------------------------------------------------* * CODE_START * * * *-------------------------------------------------------------------------*/ void Code_Start(char *label, int prolog, int global) { int i; int x = dbl_lc_no - nb_dbl; for (i = 0; i < nb_dbl; i++) { Label_Printf("%s%d:", DOUBLE_PREFIX, x++); Inst_Printf(".double", "0d%1.20e", dbl_tbl[i]); } nb_dbl = 0; Label_Printf(""); Inst_Printf(".align", "2"); #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) Inst_Printf(".type", "%s,@function", label); #endif if (global) Inst_Printf(".globl", UN "%s", label); Label(label); if (!prolog) { Inst_Printf("mr", R(12) "," R(1)); Inst_Printf("addi", R(1) "," R(1) ",-%d", MAX_C_ARGS_IN_C_CODE * 4); Inst_Printf("stw", R(12) ",0(" R(1) ")"); Inst_Printf("mflr", R(0)); Inst_Printf("stw", R(0) ",%d(" R(1) ")", (MAX_C_ARGS_IN_C_CODE + 1) * 4); } } /*-------------------------------------------------------------------------* * CODE_STOP * * * *-------------------------------------------------------------------------*/ void Code_Stop(void) { } /*-------------------------------------------------------------------------* * LABEL * * * *-------------------------------------------------------------------------*/ void Label(char *label) { Label_Printf("\n" UN "%s:", label); } /*-------------------------------------------------------------------------* * RELOAD_E_IN_REGISTER * * * *-------------------------------------------------------------------------*/ void Reload_E_In_Register(void) { #ifndef MAP_REG_E Inst_Printf("lwz", "%s,%d(%s)", asm_reg_e, MAP_OFFSET_E, asm_reg_bank); #endif } /*-------------------------------------------------------------------------* * PL_JUMP * * * *-------------------------------------------------------------------------*/ void Pl_Jump(char *label) { Inst_Printf("b", UN "%s", label); } /*-------------------------------------------------------------------------* * PREP_CP * * * *-------------------------------------------------------------------------*/ void Prep_CP(void) { #ifndef MAP_REG_CP Inst_Printf("addis", R(9) ",0," HI(.Lcont%d), w_label); Inst_Printf("addi", R(9) "," R(9) "," LO(.Lcont%d), w_label); Inst_Printf("stw", R(9) ",%s", asm_reg_cp); #else Inst_Printf("addis", "%s,0," HI(.Lcont%d), asm_reg_cp, w_label); Inst_Printf("addi", "%s,%s," LO(.Lcont%d), asm_reg_cp, asm_reg_cp, w_label); #endif } /*-------------------------------------------------------------------------* * HERE_CP * * * *-------------------------------------------------------------------------*/ void Here_CP(void) { Label_Printf(".Lcont%d:", w_label++); } /*-------------------------------------------------------------------------* * PL_CALL * * * *-------------------------------------------------------------------------*/ void Pl_Call(char *label) { Prep_CP(); Pl_Jump(label); Here_CP(); } /*-------------------------------------------------------------------------* * PL_FAIL * * * *-------------------------------------------------------------------------*/ void Pl_Fail(void) { #ifdef MAP_REG_B Inst_Printf("lwz", R(9) ",-4(%s)", asm_reg_b); #else Inst_Printf("lwz", R(9) ",%s", asm_reg_b); Inst_Printf("lwz", R(9) ",-4(" R(9) ")"); #endif Inst_Printf("mtctr", R(9)); Inst_Printf("bctr", ""); } /*-------------------------------------------------------------------------* * PL_RET * * * *-------------------------------------------------------------------------*/ void Pl_Ret(void) { #ifndef MAP_REG_CP Inst_Printf("lwz", R(0) ",%s", asm_reg_cp); Inst_Printf("mtctr", R(0)); #else Inst_Printf("mtctr", "%s", asm_reg_cp); #endif Inst_Printf("bctr", ""); } /*-------------------------------------------------------------------------* * JUMP * * * *-------------------------------------------------------------------------*/ void Jump(char *label) { Inst_Printf("b", UN "%s", label); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_X * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_X(int index) { Inst_Printf("lwz", R(0) ",%d(%s)", index * 4, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_FROM_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_From_Reg_Y(int index) { Inst_Printf("lwz", R(0) ",%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_X(int index) { Inst_Printf("stw", R(0) ",%d(%s)", index * 4, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_To_Reg_Y(int index) { Inst_Printf("stw", R(0) ",%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * CALL_C_START * * * *-------------------------------------------------------------------------*/ void Call_C_Start(char *fct_name, int fc, int nb_args, int nb_args_in_words, char **p_inline) { dbl_reg_no = 0; } #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) #define STACK_OFFSET(offset) offset * 4 - 24 #define DBL_RET_WORDS 0 #else #define STACK_OFFSET(offset) offset * 4 + 24 #define DBL_RET_WORDS 2 #endif #define MAX_ARGS_IN_REGS 8 #define BEFORE_ARG \ { \ char r[4]; \ if (offset < MAX_ARGS_IN_REGS) \ sprintf(r, R(%d), offset + 3); \ else \ strcpy(r, R(11)); #define AFTER_ARG \ if (offset >= MAX_ARGS_IN_REGS) \ Inst_Printf("stw", "%s,%d(" R(1) ")", r, STACK_OFFSET(offset)); \ } #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) #define AFTER_ARG_DBL \ } #else #define AFTER_ARG_DBL \ if (offset >= MAX_ARGS_IN_REGS) \ Inst_Printf("stfd", F(%d) ",%d(" R(1) ")", dbl_reg_no, \ offset * 4 + 24); \ } #endif /*-------------------------------------------------------------------------* * CALL_C_ARG_INT * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Int(int offset, PlLong int_val) { BEFORE_ARG; if (LITTLE_INT(int_val)) Inst_Printf("li", "%s,%ld", r, int_val); else { Inst_Printf("lis", "%s,%#x", r, IHI(int_val)); Inst_Printf("ori", "%s,%s,%#x", r, r, ILO(int_val)); } AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_DOUBLE * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Double(int offset, double dbl_val) { BEFORE_ARG; dbl_tbl[nb_dbl++] = dbl_val; Inst_Printf("addis", "%s,0," HI(%s%d), r, DOUBLE_PREFIX, dbl_lc_no); Inst_Printf("lfd", F(%d) "," LO(%s%d) "(%s)", ++dbl_reg_no, DOUBLE_PREFIX, dbl_lc_no++, r); AFTER_ARG_DBL; return DBL_RET_WORDS; } /*-------------------------------------------------------------------------* * CALL_C_ARG_STRING * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_String(int offset, int str_no) { BEFORE_ARG; Inst_Printf("addis", "%s,0," HI(%s%d), r, STRING_PREFIX, str_no); Inst_Printf("addi", "%s,%s," LO(%s%d), r, r, STRING_PREFIX, str_no); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_MEM_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Mem_L(int offset, int adr_of, char *name, int index) { BEFORE_ARG; Inst_Printf("addis", "%s,0," HI_UN(%s+%d), r, name, index * 4); if (adr_of) Inst_Printf("addi", "%s,%s," LO_UN(%s+%d), r, r, name, index * 4); else Inst_Printf("lwz", "%s," LO_UN(%s+%d) "(%s)", r, name, index * 4, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_X * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_X(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Inst_Printf("addi", "%s,%s,%d", r, asm_reg_bank, index * 4); else Inst_Printf("lwz", "%s,%d(%s)", r, index * 4, asm_reg_bank); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_REG_Y * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Reg_Y(int offset, int adr_of, int index) { BEFORE_ARG; if (adr_of) Inst_Printf("addi", "%s,%s,%d", r, asm_reg_e, Y_OFFSET(index)); else Inst_Printf("lwz", "%s,%d(%s)", r, Y_OFFSET(index), asm_reg_e); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_L * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_L(int offset, int adr_of, int index) { BEFORE_ARG; Inst_Printf("addis", "%s,0," HI_UN(pl_foreign_long+%d), r, index * 4); if (adr_of) Inst_Printf("addi", "%s,%s," LO_UN(pl_foreign_long+%d), r, r, index * 4); else Inst_Printf("lwz", "%s," LO_UN(pl_foreign_long+%d) "(%s)", r, index * 4, r); AFTER_ARG; return 1; } /*-------------------------------------------------------------------------* * CALL_C_ARG_FOREIGN_D * * * *-------------------------------------------------------------------------*/ int Call_C_Arg_Foreign_D(int offset, int adr_of, int index) { BEFORE_ARG; Inst_Printf("addis", "%s,0," HI_UN(pl_foreign_double+%d), r, #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) index * 4 #else index * 8 #endif ); if (adr_of) { Inst_Printf("addi", "%s,%s," LO_UN(pl_foreign_double+%d), r, r, index * 8); if (offset >= MAX_ARGS_IN_REGS) Inst_Printf("stw", "%s,%d(" R(1) ")", r, offset * 4 + 24); return 1; } Inst_Printf("lfd", F(%d) "," LO_UN(pl_foreign_double+%d) "(%s)", ++dbl_reg_no, index * 8, r); AFTER_ARG_DBL; return DBL_RET_WORDS; } /*-------------------------------------------------------------------------* * CALL_C_INVOKE * * * *-------------------------------------------------------------------------*/ void Call_C_Invoke(char *fct_name, int fc, int nb_args, int nb_args_in_words) { #if 0 /* only useful to call varargs functions - not the case here */ if (dbl_reg_no == 0) Inst_Printf("crxor", "6,6,6"); else Inst_Printf("creqv", "6,6,6"); #endif Inst_Printf("bl", UN "%s", fct_name); } /*-------------------------------------------------------------------------* * CALL_C_STOP * * * *-------------------------------------------------------------------------*/ void Call_C_Stop(char *fct_name, int nb_args, char **p_inline) { #ifndef MAP_REG_E if (p_inline && INL_ACCESS_INFO(p_inline)) reload_e = 1; #endif } /*-------------------------------------------------------------------------* * JUMP_RET * * * *-------------------------------------------------------------------------*/ void Jump_Ret(void) { Inst_Printf("mtctr", R(3)); Inst_Printf("bctr", ""); } /*-------------------------------------------------------------------------* * FAIL_RET * * * *-------------------------------------------------------------------------*/ void Fail_Ret(void) { Inst_Printf("cmpwi", CR(1) "," R(3) ",0"); Inst_Printf("bne", CR(1) ",.Lcont%d", w_label); Inst_Printf("b", UN "fail"); Label_Printf(".Lcont%d:", w_label++); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_MEM_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Mem_L(char *name, int index) { Inst_Printf("addis", R(4) ",0," HI_UN(%s+%d), name, index * 4); Inst_Printf("stw", R(3) "," LO_UN(%s+%d) "(" R(4) ")", name, index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_X * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_X(int index) { /* similar to Move_To_Reg_X */ Inst_Printf("stw", R(3) ",%d(%s)", index * 4, asm_reg_bank); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_REG_Y * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Reg_Y(int index) { /* similar to Move_To_Reg_Y */ Inst_Printf("stw", R(3) ",%d(%s)", Y_OFFSET(index), asm_reg_e); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_L * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_L(int index) { Inst_Printf("addis", R(4) ",0," HI_UN(pl_foreign_long+%d), index * 4); Inst_Printf("stw", R(3) "," LO_UN(pl_foreign_long+%d) "(" R(4) ")", index * 4); } /*-------------------------------------------------------------------------* * MOVE_RET_TO_FOREIGN_D * * * *-------------------------------------------------------------------------*/ void Move_Ret_To_Foreign_D(int index) { Inst_Printf("addis", R(4) ",0," HI_UN(pl_foreign_double+%d), index * 8); Inst_Printf("stfd", F(1) "," LO_UN(pl_foreign_double+%d) "(" R(4) ")", index * 8); } /*-------------------------------------------------------------------------* * CMP_RET_AND_INT * * * *-------------------------------------------------------------------------*/ void Cmp_Ret_And_Int(PlLong int_val) { if (LITTLE_INT(int_val)) Inst_Printf("cmpwi", CR(1) "," R(3) ",%ld", int_val); else { Inst_Printf("lis", R(0) ",%#x", IHI(int_val)); Inst_Printf("ori", R(0) "," R(0) ",%#x", ILO(int_val)); Inst_Printf("cmpw", CR(1) "," R(3) "," R(0)); } } /*-------------------------------------------------------------------------* * JUMP_IF_EQUAL * * * *-------------------------------------------------------------------------*/ void Jump_If_Equal(char *label) { Inst_Printf("beq", CR(1) "," UN "%s", label); } /*-------------------------------------------------------------------------* * JUMP_IF_GREATER * * * *-------------------------------------------------------------------------*/ void Jump_If_Greater(char *label) { Inst_Printf("bgt", CR(1) "," UN "%s", label); } /*-------------------------------------------------------------------------* * C_RET * * * *-------------------------------------------------------------------------*/ void C_Ret(void) { Inst_Printf("lwz", R(0) ",%d(" R(1) ")", (MAX_C_ARGS_IN_C_CODE + 1) * 4); Inst_Printf("mtlr", R(0)); Inst_Printf("addi", R(1) "," R(1) ",%d", MAX_C_ARGS_IN_C_CODE * 4); Inst_Printf("blr", ""); } /*-------------------------------------------------------------------------* * DICO_STRING_START * * * *-------------------------------------------------------------------------*/ void Dico_String_Start(int nb_consts) { #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) Label_Printf(".section\t.rodata"); #else Label_Printf(".cstring"); #endif } /*-------------------------------------------------------------------------* * DICO_STRING * * * *-------------------------------------------------------------------------*/ void Dico_String(int str_no, char *asciiz) { Label_Printf("%s%d:", STRING_PREFIX, str_no); #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) Inst_Printf(".string", "%s", asciiz); #else Inst_Printf(".asciz", "%s", asciiz); #endif } /*-------------------------------------------------------------------------* * DICO_STRING_STOP * * * *-------------------------------------------------------------------------*/ void Dico_String_Stop(int nb_consts) { } /*-------------------------------------------------------------------------* * DICO_LONG_START * * * *-------------------------------------------------------------------------*/ void Dico_Long_Start(int nb_longs) { Label_Printf(".data"); Inst_Printf(".align", "4"); } /*-------------------------------------------------------------------------* * DICO_LONG * * * *-------------------------------------------------------------------------*/ void Dico_Long(char *name, int global, VType vtype, PlLong value) { switch (vtype) { case NONE: value = 1; /* then in case ARRAY_SIZE */ case ARRAY_SIZE: #if defined(M_powerpc_linux) || defined(M_powerpc_bsd) if (!global) Inst_Printf(".local", UN "%s", name); Inst_Printf(".comm", UN "%s,%ld,4", name, value * 4); #else if (!global) Inst_Printf(".lcomm", UN "%s,%ld,4", name, value * 4); else Inst_Printf(".comm", UN "%s,%ld", name, value * 4); #endif break; case INITIAL_VALUE: if (global) Inst_Printf(".globl", UN "%s", name); Label_Printf(UN "%s:", name); Inst_Printf(".long", "%ld", value); break; } } /*-------------------------------------------------------------------------* * DICO_LONG_STOP * * * *-------------------------------------------------------------------------*/ void Dico_Long_Stop(int nb_longs) { } /*-------------------------------------------------------------------------* * DATA_START * * * *-------------------------------------------------------------------------*/ void Data_Start(char *initializer_fct) { if (initializer_fct == NULL) return; #ifdef M_powerpc_linux Inst_Printf(".section", ".ctors,\"aw\",@progbits"); Inst_Printf(".align", "2"); Inst_Printf(".long", UN "%s", initializer_fct); #else Label_Printf(".data"); Label_Printf(".mod_init_func"); Inst_Printf(".align", "2"); Inst_Printf(".long", UN "%s", initializer_fct); #endif } /*-------------------------------------------------------------------------* * DATA_STOP * * * *-------------------------------------------------------------------------*/ void Data_Stop(char *initializer_fct) { if (initializer_fct == NULL) return; #if 0 Label_Printf(".data"); Label_Printf(UN "obj_chain_stop:"); Inst_Printf(".long", UN "obj_chain_start"); #endif } ������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Ma2Asm/extract_asm.c��������������������������������������������������������������0000644�0001750�0001750�00000034230�13021324543�015646� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : mini-assembler to assembler translator * * File : extract_asm.c * * Descr.: utility to write inline assembly code for mappers * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <ctype.h> #include <unistd.h> /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_FCT 512 #define MAX_ASM_INST_PER_FCT 1024 #define MAX_LABEL_PER_FCT 1024 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int label; char code_op[32]; char args[256]; }AsmLine; /*---------------------------------* * Global Variables * *---------------------------------*/ char buff[4096]; char buff1[4096]; int nb_fct; char *fct[MAX_FCT]; int found[MAX_FCT]; int disassemble = 0; AsmLine line[MAX_ASM_INST_PER_FCT]; int nb_line; char *lab[MAX_LABEL_PER_FCT]; int nb_lab; /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Needs_Quote(char *str); char *Read_Line(char *buff, int size, FILE *f_in); void Gen_Inline(FILE *f_in, FILE *f_out, int nb_fct, char *fct[]); void Emit_Fct(int fct_no, char *fct_name, FILE *f_in, FILE *f_out); char *Get_Label(char *str); int Detect_End_Of_Fct(char *buff); /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { char *asm_file = NULL; char *c_file = NULL; char *out_file = NULL; char *flags = "-O3 -fomit-frame-pointer"; FILE *f, *f_in, *f_out; int tmp = 0; int i, r; int p_open = 1; *buff1 = '\0'; for(i = 1; i < argc; i++) { if (strcmp(argv[i], "-c") == 0) { c_file = argv[++i]; continue; } if (strcmp(argv[i], "-C") == 0) { flags = argv[++i]; continue; } if (strcmp(argv[i], "-a") == 0) { asm_file = argv[++i]; continue; } if (strcmp(argv[i], "-o") == 0) { out_file = argv[++i]; continue; } if (strcmp(argv[i], "-d") == 0) { disassemble = 1; continue; } if (strcmp(argv[i], "-c") == 0) { disassemble = 0; continue; } if (strcmp(argv[i], "-f") == 0) { if ((f = fopen(argv[++i], "r")) == NULL) { perror(argv[i]); goto error; } while(fscanf(f, "%s", buff) == 1) fct[nb_fct++] = strdup(buff); continue; } if (strcmp(argv[i], "-i") == 0) { sprintf(buff1 + strlen(buff1), " -e 's!^.*%s.*$!IGN!'", argv[++i]); continue; } if (strcmp(argv[i], "-e") == 0) { sprintf(buff1 + strlen(buff1), " -e 's!^.*%s.*$!END!'", argv[++i]); continue; } if (strcmp(argv[i], "-h") == 0) { printf("Usage: extract_asm [OPTION | FCT_NAME...]\n"); printf(" -c FILE specify C file to compile to assembly\n"); printf(" -C FLAGS specify C compiler flags\n"); printf(" -a FILE specify assembly file (input or output if -c)\n"); printf(" -o FILE specify output file (else stdout)\n"); printf(" -f FILE get the list of functions from FILE\n"); printf(" -d simply disassemble\n"); printf(" -c create C data for asm inlining\n"); printf(" -i RE ignore lines containing RE\n"); printf(" -e RE end a function when a line containing RE is read\n"); printf(" -h print this help and exit\n"); return 0; } if (*argv[i] == '-') { fprintf(stderr, "unrecognized option %s\n", argv[i]); goto error; } fct[nb_fct++] = argv[i]; } if (nb_fct == 0 && (c_file == NULL || asm_file == NULL)) { fprintf(stderr, "nothing to do - try extract_asm -h for help\n"); goto error; } if (asm_file == NULL && c_file == NULL) { fprintf(stderr, "either -c or -a option should be used\n"); goto error; } if (c_file) { if (asm_file) printf("generate asm file %s from C file %s\n", asm_file, c_file); if (asm_file == NULL) { if ((asm_file = tmpnam(NULL)) == NULL) { perror("cannot create tmp file name\n"); goto error; } else tmp = 1; } sprintf(buff, "gplc -c -C '%s -S' -o %s %s", flags, asm_file, c_file); r = system(buff); if (r == -1 || r == 127) { fprintf(stderr, "cannot execute %s\n", buff); goto error; } if (r != 0) { fprintf(stderr, "command: %s\n\treturned error code; %d\n", buff, r); goto error; } } if (*buff1) { sprintf(buff, "sed %s %s", buff1, asm_file); f_in = popen(buff, "r"), p_open = 1; } else f_in = fopen(asm_file, "r"); if (f_in == NULL) { perror(asm_file); goto error; } if (out_file == NULL) f_out = stdout; else if ((f_out = fopen(out_file, "w")) == NULL) { perror(out_file); goto error; } fprintf(f_out, "/* command:"); for(i = 0; i < argc; i++) if (Needs_Quote(argv[i])) fprintf(f_out, " '%s'", argv[i]); else fprintf(f_out, " %s", argv[i]); fprintf(f_out, " */\n\n"); Gen_Inline(f_in, f_out, nb_fct, fct); if (tmp) unlink(asm_file); if (p_open) pclose(f_in); else fclose(f_in); if (f_out != stdout) fclose(f_out); return 0; error: if (tmp) unlink(asm_file); return 1; } /*-------------------------------------------------------------------------* * NEEDS_QUOTE * * * *-------------------------------------------------------------------------*/ int Needs_Quote(char *str) { while(*str) { if (!isalnum(*str) && strchr("-_./", *str) == NULL) return 1; str++; } return 0; } /*-------------------------------------------------------------------------* * READ_LINE * * * *-------------------------------------------------------------------------*/ char * Read_Line(char *buff, int size, FILE *f_in) { char *p; do if (fgets(buff, size, f_in) == NULL) return NULL; while(strncmp(buff, "IGN", 3) == 0); for(p = buff+ strlen(buff) - 1; isspace(*p); p--) ; p[1] = '\0'; return buff; } /*-------------------------------------------------------------------------* * GEN_INLINE * * * *-------------------------------------------------------------------------*/ void Gen_Inline(FILE *f_in, FILE *f_out, int nb_fct, char *fct[]) { char *p; static char fct_name[1024]; int i, fct_no = 0; while ((Read_Line(buff, sizeof(buff), f_in)) != NULL) { p = Get_Label(buff); if (p == NULL) continue; strcpy(fct_name, p); #if 0 printf("start line: %s -- fct name (%s)\n", buff, fct_name); #endif for(i = 0; i < nb_fct; i++) if (strcmp(fct_name, fct[i]) == 0 || (*fct_name == '_' && strcmp(fct_name + 1, fct[i]) == 0)) break; if (i == nb_fct || found[i]) continue; #if 0 printf("corresponds to fct %d\n",i); #endif Emit_Fct(fct_no++, fct[i], f_in, f_out); found[i] = 1; if (fct_no == nb_fct) return; } for(i = 0; i < nb_fct; i++) if (!found[i]) fprintf(stderr, "cannot find entry code of %s\n", fct[i]); } /*-------------------------------------------------------------------------* * EMIT_FCT * * * *-------------------------------------------------------------------------*/ void Emit_Fct(int fct_no, char *fct_name, FILE *f_in, FILE *f_out) { char *p; char *start, *end; int i, l, eof; int inline_level, inline_info; nb_line = 0; nb_lab = 0; while ((Read_Line(buff, sizeof(buff), f_in)) != NULL) { eof = Detect_End_Of_Fct(buff); if (eof == 1) break; if (nb_line >= MAX_ASM_INST_PER_FCT) { fprintf(stderr, "function %s has more than %d asm lines\n", fct_name, MAX_ASM_INST_PER_FCT); exit(1); } p = Get_Label(buff); if (p) { if (nb_lab >= MAX_LABEL_PER_FCT) { fprintf(stderr, "function %s has more than %d labes\n", fct_name, MAX_LABEL_PER_FCT); exit(1); } line[nb_line].label = 1; sprintf(line[nb_line].code_op, "%d", nb_lab + 1); strcpy(line[nb_line].args, p); lab[nb_lab++] = line[nb_line].args; } else { line[nb_line].label = 0; for(p = buff; isspace(*p); p++) ; start = p; while(*p && !isspace(*p)) p++; end = p; strncpy(line[nb_line].code_op, start, end - start); line[nb_line].code_op[end - start] = '\0'; while(isspace(*p)) p++; strcpy(line[nb_line].args, p); } nb_line++; if (eof == 2) break; } /* pass 2 : code emission */ if (disassemble) fprintf(f_out, "%s:\n", fct_name); else { if (fct_no == 0) fprintf(f_out, "char *inline_asm_data[] = {\n"); else fprintf(f_out, "\n"); inline_level = 1; inline_info = 1; fprintf(f_out, " \"%s\", INL_NEXT, INL_LEVEL(%d), INL_INFO(%d),\n", fct_name, inline_level, inline_info); } if (disassemble) { for(i = 0; i < nb_line; i++) { if (line[i].label) fprintf(f_out, "%s:\n", line[i].args); else fprintf(f_out, "\t%s\t%s\n", line[i].code_op, line[i].args); } } else { for(i = 0; i < nb_line; i++) { if (line[i].label) fprintf(f_out, " INL_LABEL(%s),\n", line[i].code_op); else { for(l = 0; l < nb_lab; l++) if (strcmp(lab[l], line[i].args) == 0) break; fprintf(f_out, " \"%s\", ", line[i].code_op); if (l < nb_lab) fprintf(f_out, "INL_LABEL(%d),\n", l + 1); else fprintf(f_out, "\"%s\",\n", line[i].args); } } fprintf(f_out, " INL_END_FUNC,\n"); } if (fct_no == nb_fct - 1 && !disassemble) fprintf(f_out, "\n NULL };\n"); } /*-------------------------------------------------------------------------* * GET_LABEL * * * *-------------------------------------------------------------------------*/ char * Get_Label(char *str) { if (isspace(*buff)) return NULL; while(isalnum(*str) || strchr(".$_", *str)) str++; if (*str != ':' || str[1] != '\0') return NULL; *str = '\0'; return buff; } /*-------------------------------------------------------------------------* * DETECT_END_OF_FCT * * * * returns 0 if not the end, 1 if the end, 2 if the last * *-------------------------------------------------------------------------*/ int Detect_End_Of_Fct(char *buff) { if (strncmp(buff, "END", 3) == 0) return 1; #if defined(__i386__) if (strncmp(buff, ".Lfe", 4) == 0) return 1; #elif defined(__alpha__) if (strncmp(buff, "\t.end", 5) == 0) return 1; #elif defined(__sparc__) if (strncmp(buff, "\trestore", 8) == 0) return 2; #else { static int i=0; if (i == 0) { fprintf(stderr, "warning, Detect_End_Of_Fct() not customized" "for this architecture\n)"); i++; } } #endif return 0; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/DISTRIB_FILES���������������������������������������������������������������������0000644�0001750�0001750�00000005406�13021324543�014060� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������README INSTALL COPYING ChangeLog NEWS PROBLEMS VERSION gprolog.ico doc/README doc/Makefile doc/do_latex doc/[a-z][a-z-]?*.tex doc/[a-z][a-z]?*.sty doc/[a-z][a-z]?*.hva doc/[a-z][a-z]?*.fig doc/[a-z][a-z]?*.gif doc/[a-z][a-z]?*.eps doc/[a-z][a-z]?*.png doc/[a-z][a-z]?*.dvi doc/[a-z][a-z]?*.ps doc/[a-z][a-z]?*.pdf doc/[a-z][a-z]?*.chm doc/[a-z][a-z]?*.html doc/html_node/[a-z][a-z]?*.html doc/html_node/[a-z][a-z]?*.gif doc/html_node/[a-z][a-z]?*.hh[ckp] doc/html_node/[a-z][a-z]?*.tex doc/html_node/[a-z][a-z]?*.css doc/html_node/README doc/html_node/hh_do_hhc_hhk examples/ExamplesPl/Makefile examples/ExamplesPl/README examples/ExamplesPl/PROGS examples/ExamplesPl/??*.pl examples/ExamplesPl/YAP/[A-B,D-Z]* examples/ExamplesPl/WAMCC/[A-B,D-Z]* examples/ExamplesPl/SICSTUS/[A-B,D-Z]* examples/ExamplesPl/CIAO/[A-B,D-Z]* examples/ExamplesPl/BINPROLOG/[A-B,D-Z]* examples/ExamplesPl/XSB/[A-B,D-Z]* examples/ExamplesPl/SWI/[A-B,D-Z]* examples/ExamplesC/README examples/ExamplesC/Makefile examples/ExamplesC/??*.pl examples/ExamplesC/??*_c.c examples/ExamplesFD/Makefile examples/ExamplesFD/*.pl examples/ExamplesFD/*.fd src/.indent.pro src/Makefile.in src/DISTRIB_FILES src/SETVARS src/CSHSETVARS src/DOSSETVARS.BAT src/WINDOWS src/WINDOWS64 src/README src/AUTOCONF-INFO src/DEVELOPMENT src/PORTING src/VERSION src/config.guess src/config.sub src/configure src/configure.in src/install-sh src/mkinstalldirs src/Win32/Makefile.in src/Win32/README src/Win32/compile_install src/Win32/create_bat.c src/Win32/gp-setup.iss src/Win32/gp-vars-iss.txt.in src/Win32/addcrlf src/TopComp/Makefile.in src/TopComp/[a-z][a-z]?*.[ch] src/Pl2Wam/Makefile.in src/Pl2Wam/OTHER_PL src/Pl2Wam/boot_cp src/Pl2Wam/check_boot src/Pl2Wam/[a-z][a-z]?*.pl src/Pl2Wam/[a-z][a-z]?*.wam src/Pl2Wam/swi_pl2wam src/Pl2Wam/sics_pl2wam src/Wam2Ma/Makefile.in src/Wam2Ma/[a-z][a-z]?*.[ch] src/Ma2Asm/MA_SYNTAX src/Ma2Asm/INLINED src/Ma2Asm/Makefile.in src/Ma2Asm/[a-z][a-z0-9]?*.[ch] src/Ma2Asm/[a-z][a-z0-9]?*.ma src/Ma2Asm/FromC/Makefile src/Ma2Asm/FromC/Makefile.in src/Ma2Asm/FromC/[a-z][a-z]?*.[ch] src/Fd2C/FD_SYNTAX src/Fd2C/Makefile.in src/Fd2C/[a-z][a-z]?*.pl src/Linedit/Makefile.in src/Linedit/[a-z][a-z]?*.[ch] src/W32GUICons/Makefile.in src/W32GUICons/[a-z][a-z0-9]?*.[ch] src/W32GUICons/[a-z][a-z0-9]?*.rc src/EnginePl/Makefile.in src/EnginePl/gp_config.h.in src/EnginePl/[a-z][a-z]?*.[ch] src/EnginePl/[a-z][a-z]?*.def src/EnginePl/eng1*.s src/EnginePl/*SIGSEGV.c src/EngineFD/Makefile.in src/EngineFD/[a-z][a-z]?*.[ch] src/EngineFD/[a-z][a-z]?*.fd src/BipsPl/Makefile.in src/BipsPl/BYTE_CODE src/BipsPl/[a-z]??*.pl src/BipsPl/[a-z]??*.wam src/BipsPl/[a-z]??*.[ch] src/BipsPl/t.pl src/BipsFD/Makefile.in src/BipsFD/[a-z][a-z]?*.pl src/BipsFD/[a-z][a-z]?*.fd src/BipsFD/[a-z][a-z]?*.[ch] src/BipsFD/t.pl src/BipsFD/t_fd.fd ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/DOSSETVARS.BAT��������������������������������������������������������������������0000644�0001750�0001750�00000000306�13021324543�014132� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������@REM SET A=C:\cygwin\home\diaz\GP\src\src CD >winpwd SET /P A= <winpwd DEL winpwd SET PATH=%A%\TopComp;%A%\EnginePl;%A%\Pl2Wam;%A%\Wam2Ma;%A%\Ma2Asm;%A%\Fd2C;%A%\DevUtils;%A%\W32GUICons;%PATH% ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/mkinstalldirs���������������������������������������������������������������������0000755�0001750�0001750�00000001227�13021324543�014716� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#! /bin/sh # mkinstalldirs --- make directory hierarchy # Author: Noah Friedman <friedman@prep.ai.mit.edu> # Created: 1993-05-16 # Public domain errstatus=0 for file do set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` shift pathcomp= for d do pathcomp="$pathcomp$d" case "$pathcomp" in -* ) pathcomp=./$pathcomp ;; esac if test ! -d "$pathcomp"; then echo "mkdir $pathcomp" mkdir "$pathcomp" || lasterr=$? if test ! -d "$pathcomp"; then errstatus=$lasterr fi fi pathcomp="$pathcomp/" done done exit $errstatus # mkinstalldirs ends here �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/README����������������������������������������������������������������������������0000644�0001750�0001750�00000002461�13021324543�012771� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� General Compilation Information This directory contains the source of GNU Prolog. 1) Compiling locally -------------------- To compile the package locally use: ./configure [OPTIONS] make For more information about the options of configure refer to the INSTALL file in the parent directory. It is possible to re-run './configure' to change the value of some installation directories (see 2) after the local compilation (i.e. the compilation will not be done again). 2) Cleaning ----------- To remove installed files (remove the content of INSTALL_DIR): make uninstall To clean up the local compilation (does not erase configuration files): make clean To fully clean up the local compilation: make distclean 2) Rebuilding a source distribution ----------------------------------- To rebuild a source distribution file: make dist this will create a file gprolog-xxx.tgz (in the src directory). 3) Building a RPM distribution ------------------------------- Refer to the file src/RPM/README for more information 4) Building a debian package ---------------------------- Refer to the file src/debian/README for more information 5) Building a Win32 auto-install distribution --------------------------------------------- Refer to the file src/Win32/README for more information ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/install-sh������������������������������������������������������������������������0000755�0001750�0001750�00000012736�13021324543�014123� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5 (mit/util/scripts/install.sh). # # Copyright 1991 by the Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: chmodcmd="" else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 ����������������������������������gprolog-1.4.5/src/.gitignore������������������������������������������������������������������������0000644�0001750�0001750�00000000250�13021324543�014073� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#* .#* TO_DO TO_OPTIMIZE CONF MSCONF VC_TODO Makefile LocalStuff Release TestsPl DevUtils configure config.status config.cache autom4te.cache config.log gprolog-*.tar* ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/PORTING���������������������������������������������������������������������������0000644�0001750�0001750�00000010621�13021324543�013153� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Here are some help to port GNU Prolog. 1) I suppose you are in ROOT_DIR/src: . ./SETVARS (or source CSHSETVARS if you are under csh) ./configure --with-c-flags=debug --with-c-flags=debug is a "good" option to allow you to use the C debugger, you can always use this until a final point is reached. This allows you to execute the locally compiled version (see file DEVELOPMENT for more info). 2) Modify the following files to create an entry M_<processor>_<os> configure.in (+CFLAGS and others) EnginePl/gp_config.h.in (M_<processor>_<os>) EnginePl/machine.h (+regs) eventually look at EnginePl/arch_dep.h 3) you must be able to compile the following: cd EnginePl ; make engine.o engine1.o 4) Create the translation file (in the Ma2Asm/ directory). GNU Prolog compiles a Prolog source to a low-level machine independent language called mini-assembly. You have to write a translator for the target machine (mini-asm to assembly). You can use an existing translation file as example and/or look at the assembly produced by gcc. For that you can do: cd Ma2Asm/FromC make This will create a file asm_inst.s from asm_inst.c. The study of both files can help you to write the translater (in Ma2Asm/). You can check your translation using the chkma program (in Ma2Asm/): make chkma ./chkma You should obtain something like: reg_bank=&X(0):0x8052a00 B:0x8053ac0 E:0x8054ac0 &Y(0):0x8054ab0 stack:0x8053ac0 test 1: c_code intializer... test 1 OK test 2: long local/global ... test 2 OK test 3: pl_jump/pl_ret... test 3 OK test 4: pl_call/pl_ret/pl_fail... test 4 OK test 5: prep_cp/here_cp... test 5 OK test 6: jump/c_ret... test 6 OK test 7: call_c(void)... test 7 OK test 8: move X(i) to Y(j)... test 8 OK test 9: move Y(i) to X(j)... test 9 OK test 10: call_c(int)... test 10 OK test 11: call_c(double)... test 11 OK test 12: call_c(string)... test 12 OK test 13: call_c(mem,&label,mem(...),&mem(...))... test 13 OK test 14: call_c(X())... test 14 OK test 15: call_c(Y())... test 15 OK test 16: call_c(FL())... test 16 OK test 17: call_c(FD())... test 17 OK test 18: call_c(lot_of_args)... test 18 OK test 19: call_c()+jump_ret... test 19 OK test 20: call_c()+fail_ret... test 20 OK test 21: call_c()+move_ret mem... test 21 OK test 22: call_c()+move_ret X()... test 22 OK test 23: call_c()+move_ret Y()... test 23 OK test 24: call_c()+move_ret FL()... test 24 OK test 25: call_c()+move_ret FD()... test 25 OK test 26: call_c()+switch_ret... test 26 OK MA checks suceeded (you can use make clean-chkma to erase chkma objects/execs) All tests must be OK else you have an error in the corresponding tested point. At this point you should discover which part is not OK. 5) Check that ObjChain works: ObjChain is a way to find at run-time which Prolog modules are linked (to then initialize them). Normally this should be OK but you can test it. cd EnginePl make test_oc ./test_oc This will find 5 modules and display somthing like: starting... object <object #5> found &name:0x804c200 object <object #4> found &name:0x804c1e0 object <object #3> found &name:0x804c1c0 object <object #2> found &name:0x804c1a0 object <object #1> found &name:0x804c180 finished - OK ! The important point to check is if 5 modules are found and peferably in reverse order. If not you have to debug the file EnginePl/obj_chain.c. Since 1.3.0 we use gcc __atribute__((constructor)). (you can use make clean-test_oc to erase test objects/execs) 6) When this is OK (i.e. a Prolog program can be compiled and executed) you will have to check if the stack overflow detection is ok. See file EnginePl/machine.c (function SIGSEGV_Handler). The important point here is to obtain the address which caused the SIGSEGV (the rest of the function detects which stack is involved from that addresss). look at the files EnginePl/*_SIGSEGV.C other things to do when porting: ma2asm (use chkma) (call_c needs at least 7 args) test with all combinations of mapped registers machine.c: SIGSEGV_Handler engine1.c: what to do #ifndef MAP_REG_BANK things to test: linedit floats (e.g. write(1.23),...) statistics os stuffs random ctrl/c (prg TEST_CTRLC.c) 7) Once all compile fine and pl2wam and gprolog executables are created you can check the bootstraping by: cd Pl2Wam make check Bootstrap Prolog Compiler OK the same for Built-ins; cd ../BipsPl make check Bootstrap Prolog Bips OK ���������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/.indent.pro�����������������������������������������������������������������������0000644�0001750�0001750�00000010043�13021324543�014165� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������-gnu /* GNU coding style */ -bad /* blank line after every block of declarations */ -bap /* blank line after every procedure body */ -npcs /* no space between the name of the function and ( */ -cs /* space after cast operator */ -l76 /* normal line length */ -lc80 /* comment line length */ /* types */ -T time_t -T size_t -T fd_set -T FILE -T AliasInf -T ArgInf -T ArgTyp -T ArgVal -T ArithInf -T AtomInf -T AtomProp -T BCCodOp -T BCWord -T Bool -T BTNode -T BTString -T CmdInf -T CmpFct -T CodePtr -T CompNode -T CPT -T CPTCell -T CPTList -T CPTMatch -T CPTNode -T CPTStat -T CPTTree -T DblInt -T DblUns -T Direct -T DirectP -T DSwtInf -T DynCInf -T DynCInfP -T DynPInf -T DynPInfP -T DynScan -T DynStamp -T Elem -T ExeInf -T FctPtr -T FileInf -T FIOArg -T GmListElement -T GVarElt -T HashNode -T HashScan -T HistCell -T InfCmd -T InfLong -T InfLongP -T InfSig -T InfStack -T InfTag -T InfVar -T InstInf -T LineInf -T mbinptr -T mchunkptr -T Mem -T Monom -T NonLin -T ObjChain -T ObjInf -T OneSol -T OneSolP -T OperInf -T PbStk -T PBTNode -T PObjChain -T Poly -T Pred -T PredInf -T PredP -T PrefInf -T PSwtTbl -T PtrUns -T Range -T RegInf -T ScanFct -T SFOp -T StackInf -T StmFct -T StmInf -T StmProp -T StrSInf -T SwtElt -T SwtInf -T SwtTbl -T TagInf -T TermIO -T TermSInf -T TokInf -T TTYInf -T TypTag -T TypTok -T UsedFile -T Vector -T VecWord -T VType -T WamCont -T WamWord -T WamWordP -T Fct -T ABORTPROC -T ACMDRIVERENUMCB -T ACMDRIVERPROC -T ACMFILTERCHOOSEHOOKPROC -T ACMFILTERENUMCB -T ACMFILTERTAGENUMCB -T ACMFORMATCHOOSEHOOKPROC -T ACMFORMATENUMCB -T ACMFORMATTAGENUMCB -T APPLET_PROC -T ATOM -T BOOL -T BOOLEAN -T BYTE -T CALINFO_ENUMPROC -T CALLBACK -T CHAR -T COLORREF -T CONST -T CRITICAL_SECTION -T CTRYID -T DATEFMT_ENUMPROC -T DESKTOPENUMPROC -T DLGPROC -T DRAWSTATEPROC -T DWORD -T EDITWORDBREAKPROC -T ENHMFENUMPROC -T ENUMRESLANGPROC -T ENUMRESNAMEPROC -T ENUMRESTYPEPROC -T FARPROC -T FLOAT -T FILE_SEGMENT_ELEMENT -T FONTENUMPROC -T GOBJENUMPROC -T GRAYSTRINGPROC -T HACCEL -T HANDLE -T HBITMAP -T HBRUSH -T HCOLORSPACE -T HCONV -T HCONVLIST -T HCURSOR -T HDC -T HDDEDATA -T HDESK -T HDROP -T HDWP -T HENHMETAFILE -T HFILE -T HFONT -T HGDIOBJ -T HGLOBAL -T HHOOK -T HICON -T HIMAGELIST -T HIMC -T HINSTANCE -T HKEY -T HKL -T HLOCAL -T HMENU -T HMETAFILE -T HMODULE -T HMONITOR -T HOOKPROC -T CallWndProc -T CallWndRetProc -T CBTProc -T DebugProc -T ForegroundIdleProc -T GetMsgProc -T JournalPlaybackProc -T JournalRecordProc -T KeyboardProc -T LowLevelKeyboardProc -T LowLevelMouseProc -T MessageProc -T MouseProc -T ShellProc -T SysMsgProc -T HPALETTE -T HPEN -T HRGN -T HRSRC -T HSZ -T HTREEITEM -T HWINSTA -T HWND -T INT -T IPADDR -T LANGID -T LCID -T LCSCSTYPE -T LCSGAMUTMATCH -T LCTYPE -T LINEDDAPROC -T LOCALE_ENUMPROC -T LONG -T LONGLONG -T LPARAM -T LPBOOL -T LPBYTE -T LPCCHOOKPROC -T LPCFHOOKPROC -T LPCOLORREF -T LPCRITICAL_SECTION -T LPCSTR -T LPCTSTR -T LPCVOID -T LPCWSTR -T LPDWORD -T LPFIBER_START_ROUTINE -T LPFRHOOKPROC -T LPHANDLE -T LPHANDLER_FUNCTION -T LPINT -T LPLONG -T LPOFNHOOKPROC -T LPPAGEPAINTHOOK -T LPPAGESETUPHOOK -T LPPRINTHOOKPROC -T LPPROGRESS_ROUTINE -T LPSETUPHOOKPROC -T LPSTR -T LPSTREAM -T LPTHREAD_START_ROUTINE -T LPTSTR -T LPVOID -T LPWORD -T LPWSTR -T LRESULT -T LUID -T PBOOL -T PBOOLEAN -T PBYTE -T PCHAR -T PCRITICAL_SECTION -T PCSTR -T PCTSTR -T PCWCH -T PCWSTR -T PDWORD -T PFLOAT -T PFNCALLBACK -T PHANDLE -T PHANDLER_ROUTINE -T PHKEY -T PINT -T PLCID -T PLONG -T PLUID -T PROPENUMPROC -T PROPENUMPROCEX -T PSHORT -T PSTR -T PTBYTE -T PTCHAR -T PTIMERAPCROUTINE -T PTSTR -T PUCHAR -T PUINT -T PULONG -T PUSHORT -T PVOID -T PWCHAR -T PWORD -T PWSTR -T REGISTERWORDENUMPROC -T REGSAM -T SC_HANDLE -T SC_LOCK -T SENDASYNCPROC -T SERVICE_STATUS_HANDLE -T SHORT -T TBYTE -T TCHAR -T TIMEFMT_ENUMPROC -T TIMERPROC -T UCHAR -T UINT -T ULONG -T ULONGLONG -T UNSIGNED -T USHORT -T VOID -T WCHAR -T WINAPI -T WINSTAENUMPROC -T WNDENUMPROC -T EnumChildProc -T EnumThreadWndProc -T EnumWindowsProc -T WNDPROC -T WORD -T WPARAM -T YIELDPROC -T LOGFONT -T CHOOSEFONT -T WNDCLASS -T RECT -T PAINTSTRUCT -T HH_AKLINK -T LPMALLOC -T BROWSEINFO -T LPITEMIDLIST ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/���������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013176� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/wam_parser.c���������������������������������������������������������������0000644�0001750�0001750�00000046543�13021324543�015512� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : WAM to mini-assembler translator * * File : wam_parser.c * * Descr.: parser * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <string.h> #include <ctype.h> #include <setjmp.h> #include <locale.h> #include "wam_parser.h" #include "wam_protos.h" #include "../EnginePl/pl_long.h" /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_FCT_ARITY 10 #define MAX_LINE_LEN 65536 #define MAX_STR_LEN 32768 #define MAX_ARGS 65536 /* for big swith_on_... */ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { char *keyword; void (*fct) (); int nb_args; ArgTyp arg_type[MAX_FCT_ARITY]; } ParseInf; /*---------------------------------* * Global Variables * *---------------------------------*/ ParseInf decl[] = { {"file_name", F_file_name, 1, {ATOM}}, {"directive", F_directive, 3, {INTEGER, ATOM, LIST_INST}}, {"predicate", F_predicate, 7, {MP_N, INTEGER, ATOM, ATOM, ATOM, ATOM, LIST_INST}}, {"ensure_linked", F_ensure_linked, 1, {L1(MP_N)}}, {NULL, NULL, 0, {0}} }; ParseInf inst[] = { {"get_variable", F_get_variable, 2, {X_Y, INTEGER}}, {"get_value", F_get_value, 2, {X_Y, INTEGER}}, {"get_atom", F_get_atom, 2, {ATOM, INTEGER}}, {"get_integer", F_get_integer, 2, {INTEGER, INTEGER}}, {"get_float", F_get_float, 2, {FLOAT, INTEGER}}, {"get_nil", F_get_nil, 1, {INTEGER}}, {"get_list", F_get_list, 1, {INTEGER}}, {"get_structure", F_get_structure, 2, {F_N, INTEGER}}, {"put_variable", F_put_variable, 2, {X_Y, INTEGER}}, {"put_void", F_put_void, 1, {INTEGER}}, {"put_value", F_put_value, 2, {X_Y, INTEGER}}, {"put_unsafe_value", F_put_unsafe_value, 2, {X_Y, INTEGER}}, {"put_atom", F_put_atom, 2, {ATOM, INTEGER}}, {"put_integer", F_put_integer, 2, {INTEGER, INTEGER}}, {"put_float", F_put_float, 2, {FLOAT, INTEGER}}, {"put_nil", F_put_nil, 1, {INTEGER}}, {"put_list", F_put_list, 1, {INTEGER}}, {"put_structure", F_put_structure, 2, {F_N, INTEGER}}, {"put_meta_term", F_put_meta_term, 3, {ATOM, INTEGER, INTEGER}}, {"math_load_value", F_math_load_value, 2, {X_Y, INTEGER}}, {"math_fast_load_value", F_math_fast_load_value, 2, {X_Y, INTEGER}}, {"unify_variable", F_unify_variable, 1, {X_Y}}, {"unify_void", F_unify_void, 1, {INTEGER}}, {"unify_value", F_unify_value, 1, {X_Y}}, {"unify_local_value", F_unify_local_value, 1, {X_Y}}, {"unify_atom", F_unify_atom, 1, {ATOM}}, {"unify_integer", F_unify_integer, 1, {INTEGER}}, {"unify_nil", F_unify_nil, 0, {0}}, {"unify_list", F_unify_list, 0, {0}}, {"unify_structure", F_unify_structure, 1, {F_N}}, {"allocate", F_allocate, 1, {INTEGER}}, {"deallocate", F_deallocate, 0, {0}}, {"call", F_call, 1, {MP_N}}, {"execute", F_execute, 1, {MP_N}}, {"proceed", F_proceed, 0, {0}}, {"fail", F_fail, 0, {0}}, {"label", F_label, 1, {INTEGER}}, {"switch_on_term", F_switch_on_term, 5, {LABEL, LABEL, LABEL, LABEL, LABEL}}, {"switch_on_atom", F_switch_on_atom, 1, {L2(ATOM, INTEGER)}}, {"switch_on_integer", F_switch_on_integer, 1, {L2(INTEGER, INTEGER)}}, {"switch_on_structure", F_switch_on_structure, 1, {L2(F_N, INTEGER)}}, {"try_me_else", F_try_me_else, 1, {INTEGER}}, {"retry_me_else", F_retry_me_else, 1, {INTEGER}}, {"trust_me_else_fail", F_trust_me_else_fail, 0, {0}}, {"try", F_try, 1, {INTEGER}}, {"retry", F_retry, 1, {INTEGER}}, {"trust", F_trust, 1, {INTEGER}}, {"pragma_arity", F_pragma_arity, 1, {INTEGER}}, {"get_current_choice", F_get_current_choice, 1, {X_Y}}, {"cut", F_cut, 1, {X_Y}}, {"soft_cut", F_soft_cut, 1, {X_Y}}, {"call_c", F_call_c, 3, {ATOM, L1(ANY), L1(ANY)}}, {"foreign_call_c", F_foreign_call_c, 5, {ATOM, ATOM, F_N, INTEGER, L2(ATOM, ATOM)}}, {NULL, NULL, 0, {0}} }; ArgVal arg[MAX_ARGS]; jmp_buf jumper; /* scanner variables */ int keep_source_lines; FILE *file_in; int cur_line_no; char cur_line_str[MAX_LINE_LEN]; char *cur_line_p; char *beg_last_token; char str_val[MAX_STR_LEN]; PlLong int_val; double dbl_val; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Parser(void); static int Parse_And_Treat_Decl_Or_Inst(ParseInf *in); static void Read_Argument(ArgTyp arg_type, ArgVal **top); static void Read_Token(int what); static int Scanner(int complex_atom); static char Peek_Char(int skip_spaces); /*-------------------------------------------------------------------------* * PARSE_MAM_FILE * * * *-------------------------------------------------------------------------*/ int Parse_Wam_File(char *file_name_in, int comment) { int ret_val; keep_source_lines = comment; if (file_name_in == NULL) file_in = stdin; else if ((file_in = fopen(file_name_in, "rt")) == NULL) { fprintf(stderr, "cannot open input file %s\n", file_name_in); return 0; } cur_line_p = cur_line_str; cur_line_str[0] = '\0'; cur_line_no = 0; if ((ret_val = setjmp(jumper)) == 0) Parser(); if (file_in != stdin) fclose(file_in); return ret_val == 0; } /*-------------------------------------------------------------------------* * PARSER * * * *-------------------------------------------------------------------------*/ static void Parser(void) { for(;;) { if (!Parse_And_Treat_Decl_Or_Inst(decl)) /* end of file */ break; Read_Token('.'); } } /*-------------------------------------------------------------------------* * READ_DECL_OR_INST * * * *-------------------------------------------------------------------------*/ static int Parse_And_Treat_Decl_Or_Inst(ParseInf *what) { ParseInf *in = what; ArgVal *top = arg; int i, k; int fct_called = 0; k = Scanner(0); if (k == 0 && what == decl) /* end of file */ return 0; if (k != ATOM) Syntax_Error((what == decl) ? "wam declaration expected" : "wam instruction expected"); for(in = what; in->keyword && strcmp(str_val, in->keyword) != 0; in++) ; if (in->keyword == NULL) Syntax_Error((what == decl) ? "unknown wam declaration" : "unknown wam instruction"); if (in->nb_args) { Read_Token('('); for (i = 0; i < in->nb_args; i++) { if (i > 0) Read_Token(','); if (in->arg_type[i] == LIST_INST) { (*in->fct) (arg); fct_called = 1; Read_Token('['); for (;;) { Parse_And_Treat_Decl_Or_Inst(inst); /* only works because LIST_INST is the last argument */ k = Scanner(0); if (k == ']') break; if (k != ',') Syntax_Error("] or , expected"); } } else Read_Argument(in->arg_type[i], &top); } Read_Token(')'); } if (!fct_called) (*in->fct) (arg); return 1; } /*-------------------------------------------------------------------------* * READ_ARGUMENT * * * * arguments are loaded in the array 'arg' as follows: * * * * ATOM : the (char *) pointing to a copy of the associated string * * INTEGER : the associated (int) * * FLOAT : the associated (double) * * X_Y : the (int) associated to the var no (Y vars from 5000) * * F_N : the loading of ATOM (F) and the loading of INTEGER (N) * * MP_N : the loading of ATOM (M) or NULL (no module) followed by F_N * * the loading of ATOM (F) and the loading of INTEGER (N) * * LABEL : the associated (int) or -1 for 'fail' * * ANY : the type of the arg (an INTEGER) and the loading of arg * * L1(T) : an (int) n associated to the number of elements and * * n * the loading of T * * L2(T1, T2): an (int) n associated to the number of elements and * * n * (the loading of T1 followed by the loading of T2) * *-------------------------------------------------------------------------*/ static void Read_Argument(ArgTyp arg_type, ArgVal **top) { int k, n; ArgVal *top1; ArgTyp t1, t2; switch (arg_type) { case ATOM: Read_Token(ATOM); Add_Arg(*top, char *, strdup(str_val)); return; case INTEGER: Read_Token(INTEGER); load_integer: Add_Arg(*top, PlLong, int_val); return; case FLOAT: Read_Token(FLOAT); load_float: Add_Arg(*top, double, dbl_val); return; case X_Y: if (Scanner(0) != ATOM || (*str_val != 'x' && *str_val != 'y') || str_val[1] != '\0') Syntax_Error("x(...) or y(...) expected"); load_x_y: Read_Token('('); Read_Token(INTEGER); Read_Token(')'); if (*str_val == 'x') Add_Arg(*top, PlLong, int_val); else Add_Arg(*top, PlLong, 5000 + int_val); return; case F_N: Read_Argument(ATOM, top); Read_Token('/'); Read_Argument(INTEGER, top); return; case MP_N: Read_Token(ATOM); k = Scanner(0); if (k == ':') { Add_Arg(*top, char *, strdup(str_val)); Read_Token(ATOM); Add_Arg(*top, char *, strdup(str_val)); Read_Token('/'); } else if (k == '/') { Add_Arg(*top, char *, NULL); Add_Arg(*top, char *, strdup(str_val)); } else Syntax_Error("/ or : expected"); Read_Argument(INTEGER, top); return; case LABEL: k = Scanner(0); if (k != INTEGER) { if (k != ATOM || strcmp(str_val, "fail") != 0) Syntax_Error("label or fail expected"); else int_val = -1; } Add_Arg(*top, PlLong, int_val); return; case ANY: t1 = Scanner(1); top1 = *top; /* to update type if needed */ Add_Arg(*top, PlLong, t1); if (t1 == INTEGER) goto load_integer; if (t1 == FLOAT) goto load_float; if (t1 != ATOM) Syntax_Error("x(...), y(...), atom, integer or float expected"); /* t1 is an ATOM */ if ((*str_val == 'x' || *str_val == 'y') && str_val[1] == '\0' && Peek_Char(0) == '(') { Add_Arg(top1, PlLong, X_Y); goto load_x_y; } Add_Arg(*top, char *, strdup(str_val)); /* load the atom */ if (Peek_Char(1) == '/') { Read_Token('/'); Read_Argument(INTEGER, top); Add_Arg(top1, PlLong, F_N); } return; case LIST_INST: /* should not occur */ fprintf(stderr, "BAD Read_Argument(LIST_INST) !!!\n"); return; } /* arg_type is a list L1(t) or L2(t1, t2) */ DECODE_L2(arg_type, t1, t2); top1 = *top; Add_Arg(*top, PlLong, 0); /* reserve space for counter */ n = 0; k = Scanner(1); if (k == ATOM && strcmp(str_val, "[]") == 0) /* empty list */ return; if (k != '[') Syntax_Error("[] or [ expected"); for (;;) { n++; if (t2 == 0) /* case L1(t1) */ Read_Argument(t1, top); else /* case L2(t1, t2) */ { Read_Token('('); Read_Argument(t1, top); Read_Token(','); Read_Argument(t2, top); Read_Token(')'); } k = Scanner(0); if (k == ']') break; if (k != ',') Syntax_Error("] or , expected"); } Add_Arg(top1, PlLong, n); } /*-------------------------------------------------------------------------* * PL_READ_TOKEN * * * *-------------------------------------------------------------------------*/ static void Read_Token(int what) { char str[80]; int k; k = Scanner(what == ATOM); if (k == what) return; if (what >= 256 && k == '(') { Read_Token(what); /* maybe ( what ) (useful for operators) */ Read_Token(')'); return; } switch (what) { case ATOM: Syntax_Error("atom expected"); break; case INTEGER: Syntax_Error("integer expected"); break; case FLOAT: Syntax_Error("float expected"); break; default: sprintf(str, "%c expected", what); Syntax_Error(str); break; } } /*-------------------------------------------------------------------------* * SCANNER * * * *-------------------------------------------------------------------------*/ static int Scanner(int complex_atom) { char *p, *p1; PlLong i; double d; double strtod(); for (;;) { while (isspace(*cur_line_p)) cur_line_p++; if (*cur_line_p != '\0' && *cur_line_p != '%') break; if (fgets(cur_line_str, sizeof(cur_line_str), file_in)) /* to avoid gcc warning warn_unused_result */ { } if (feof(file_in)) return 0; cur_line_no++; cur_line_p = cur_line_str; if (keep_source_lines) { while (isspace(*cur_line_p)) cur_line_p++; if (*cur_line_p) { p = cur_line_p + strlen(cur_line_p) - 1; if (*p == '\n') *p = '\0'; Source_Line(cur_line_no, cur_line_p); } } } beg_last_token = cur_line_p; if (*cur_line_p == '\'') /* quoted atom */ { p = str_val; cur_line_p++; while (*cur_line_p != '\'' || cur_line_p[1] == '\'') { if (*cur_line_p == '\'') { *p++ = '\''; cur_line_p += 2; continue; } if (*cur_line_p == '\"') { *p++ = '\\'; *p++ = '"'; cur_line_p++; continue; } if ((*p++ = *cur_line_p++) == '\\') { if (*cur_line_p == '\\' || /* \\ */ strchr("abfnrtv", *cur_line_p)) /* \a \b \f \n \r \t \v */ *p++ = *cur_line_p++; else { if (*cur_line_p == 'x') { cur_line_p++; i = 16; } else i = 8; i = strtol(cur_line_p, &p1, i); /* stop on the closing \ */ cur_line_p = p1 + 1; sprintf(p, "%03" PL_FMT_o, i); p += 3; } } } cur_line_p++; *p = '\0'; return ATOM; } if (isalpha(*cur_line_p) || *cur_line_p == '_') /* atom */ { p = str_val; while (isalnum(*cur_line_p) || *cur_line_p == '_') *p++ = *cur_line_p++; *p = '\0'; return ATOM; } if (complex_atom) { if ((cur_line_p[0] == '[' && cur_line_p[1] == ']') || /* [] and {} */ (cur_line_p[0] == '{' && cur_line_p[1] == '}')) { str_val[0] = *cur_line_p++; str_val[1] = *cur_line_p++; str_val[2] = '\0'; return ATOM; } if (strchr("#$&*+-./:<=>?@\\^~", *cur_line_p)) /* symbol char */ { p = str_val; do { if (*cur_line_p == '"' || *cur_line_p == '\\') *p++ = '\\'; *p++ = *cur_line_p++; } while (strchr("#$&*+-./:<=>?@\\^~", *cur_line_p)); *p = '\0'; return ATOM; } if (strchr("!;,", *cur_line_p)) /* solo char */ { str_val[0] = *cur_line_p++; str_val[1] = '\0'; return ATOM; } } i = Str_To_PlLong(cur_line_p, &p, 0); if (p == cur_line_p) /* not an integer return that character */ return *cur_line_p++; d = strtod(cur_line_p, &p1); if (p1 == p) /* integer */ { int_val = i; cur_line_p = p; return INTEGER; } /* float */ dbl_val = d; cur_line_p = p1; return FLOAT; } /*-------------------------------------------------------------------------* * PEEK_CHAR * * * *-------------------------------------------------------------------------*/ static char Peek_Char(int skip_spaces) { char *p = cur_line_p; if (skip_spaces) while(isspace(*p)) p++; return *p; } /*-------------------------------------------------------------------------* * PL_SYNTAX_ERROR * * * *-------------------------------------------------------------------------*/ void Syntax_Error(char *s) { char *p = cur_line_str + strlen(cur_line_str) - 1; if (*p == '\n') *p = '\0'; fprintf(stderr, "line %d: %s\n", cur_line_no, s); fprintf(stderr, "%s\n", cur_line_str); for (p = cur_line_str; p < beg_last_token; p++) if (!isspace(*p)) *p = ' '; *p = '\0'; fprintf(stderr, "%s^ here\n", cur_line_str); longjmp(jumper, 1); } �������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/bt_string.h����������������������������������������������������������������0000644�0001750�0001750�00000007416�13021324543�015346� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : WAM to mini-assembler translator * * File : bt_string.h * * Descr.: string dico management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct btnode *PBTNode; typedef struct btnode { char *str; int no; #if WORD_SIZE == 64 int filler; /* to preserve 64-bits align for info=PlLong (to avoid a SIGBUS) */ #endif char info[32]; /* a buffer to store some information */ PBTNode left; PBTNode right; } BTNode; typedef struct { BTNode *tree; int nb_elem; } BTString; typedef void (*BTStrLstFct) (int no, char *str, void *info); /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void BT_String_Init(BTString *bt_str); BTNode *BT_String_Add(BTString *bt_str, char *str); BTNode *BT_String_Lookup(BTString *bt_str, char *str); void BT_String_List(BTString *bt_str, BTStrLstFct fct); ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/wam2ma.c�������������������������������������������������������������������0000644�0001750�0001750�00000204644�13021324543�014534� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : WAM to mini-assembler translator * * File : wam2ma.c * * Descr.: code generation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <string.h> #include <locale.h> #include "../EnginePl/gp_config.h" #include "../EnginePl/arch_dep.h" #define ONLY_TAG_PART #include "../EnginePl/wam_archi.h" #include "../EnginePl/pl_params.h" #include "../EnginePl/pred.h" #include "wam_parser.h" #include "wam_protos.h" #include "bt_string.c" #include "../TopComp/copying.c" #include "../TopComp/decode_hexa.c" #ifdef FC_USED_TO_COMPILE_CORE #define FAST "fast " #else #define FAST #endif #if 1 #define USE_TAGGED_CALLS_FOR_WAM_FCTS #endif #if 0 #define CHECK_PRINTF_ARGS #endif #ifdef CHECK_PRINTF_ARGS #define GCCPRINTF(x) __attribute__((format(printf, x, x + 1))) #else #define GCCPRINTF(x) #endif /*---------------------------------* * Constants * *---------------------------------*/ #define DEFAULT_OUTPUT_SUFFIX ".ma" #define MAX_PRED_NAME_LENGTH 2048 #define MAX_HEXA_LENGTH MAX_PRED_NAME_LENGTH * 2 + 2 + 16 #define MAX_LABEL_LENGTH 32 #define ANY_SIZE 1 #define FOREIGN_TYPE_INTEGER 0 #define FOREIGN_TYPE_POSITIVE 1 #define FOREIGN_TYPE_FLOAT 2 #define FOREIGN_TYPE_NUMBER 3 #define FOREIGN_TYPE_ATOM 4 #define FOREIGN_TYPE_BOOLEAN 5 #define FOREIGN_TYPE_CHAR 6 #define FOREIGN_TYPE_IN_CHAR 7 #define FOREIGN_TYPE_CODE 8 #define FOREIGN_TYPE_IN_CODE 9 #define FOREIGN_TYPE_BYTE 10 #define FOREIGN_TYPE_IN_BYTE 11 #define FOREIGN_TYPE_STRING 12 #define FOREIGN_TYPE_CHARS 13 #define FOREIGN_TYPE_CODES 14 #define FOREIGN_TYPE_TERM 15 #define FOREIGN_TBL_SIZE 16 #define FOREIGN_MODE_IN 0 #define FOREIGN_MODE_OUT 1 #define FOREIGN_MODE_IN_OUT 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct swt_elt { BTNode *atom; PlLong n; PlLong label; } SwtElt; typedef struct swt_tbl *PSwtTbl; typedef struct swt_tbl { enum { TBL_ATM, /* key: atom */ TBL_INT, /* key: n (used if SWT_INT_NO_OPT) */ TBL_STC /* key: atom/n */ } type; int tbl_no; /* sequential no of the table */ PSwtTbl next; /* next table */ int nb_elem; /* number of elements */ SwtElt elem[ANY_SIZE]; /* table of switch elements */ } SwtTbl; typedef struct predinf *PredP; typedef struct predinf { BTNode *module; /* not NULL */ BTNode *functor; int arity; char *hexa; int line_no; int prop; BTNode *pl_file; int pl_line; SwtTbl *swt_tbl[3]; PredP next; } Pred; typedef struct directinf *DirectP; typedef struct directinf { BTNode *pl_file; int pl_line; int system; DirectP next; } Direct; /*---------------------------------* * Global Variables * *---------------------------------*/ char *file_name_in; char *file_name_out; int comment; FILE *file_out; BTString bt_atom; BTString bt_tagged_atom; BTString bt_tagged_f_n; BTNode *cur_pl_file; char buff_hexa[MAX_HEXA_LENGTH]; Pred dummy_pred_start; Pred *pred_end = &dummy_pred_start; Direct dummy_direct_start; Direct *direct_end = &dummy_direct_start; int nb_swt_tbl = 0; Pred *cur_pred; int cur_pred_no = 0; int cur_arity; PlLong cur_sub_label; int cur_direct_no = 0; char *foreign_tbl[FOREIGN_TBL_SIZE]; /*---------------------------------* * Function Prototypes * *---------------------------------*/ SwtTbl *Create_Switch_Table(int type, int nb_elem); void Init_Foreign_Table(void); void Emit_Obj_Initializer(void); void Emit_Exec_Directives(void); void Emit_One_Atom(int no, char *str, void *info); void Emit_One_Atom_Tagged(int no, char *str, void *info); int Add_F_N_Tagged(char *atom, int n); void Emit_One_F_N_Tagged(int no, char *str, void *info); void Label_Printf(char *label, ...) GCCPRINTF(1); void Inst_Printf(char *op, char *operands, ...) GCCPRINTF(2); void Parse_Arguments(int argc, char *argv[]); void Display_Help(void); #define Check_Arg(i, str) (strncmp(argv[i], str, strlen(argv[i])) == 0) #define DEF_STR(str) char *str #define LOAD_STR(str) Get_Arg(top, char *, str) #define DEF_ATOM(atom) BTNode *atom; char *str_##atom #define LOAD_ATOM_T(atom, t) Get_Arg(top, char *, str_##atom); \ atom = BT_String_Add(&t, str_##atom) #define LOAD_ATOM_0(atom) LOAD_ATOM_T(atom, bt_atom) #define LOAD_ATOM_1(atom) LOAD_ATOM_T(atom, bt_tagged_atom) #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS #define LOAD_ATOM(atom) LOAD_ATOM_1(atom) #else #define LOAD_ATOM(atom) LOAD_ATOM_0(atom) #endif #define DEF_INTEGER(n) PlLong n #define LOAD_INTEGER(n) Get_Arg(top, PlLong, n) #define DEF_FLOAT(n) double n #define LOAD_FLOAT(n) Get_Arg(top, double, n) #define DEF_X_Y(xy) PlLong xy; char c #define LOAD_X_Y(xy) Get_Arg(top, PlLong, xy); \ if (xy < 5000) c = 'X'; else xy -= 5000, c='Y' #define DEF_F_N_0(atom, n) DEF_ATOM(atom); DEF_INTEGER(n) #define DEF_F_N_1(atom, n) DEF_STR(str_##atom); DEF_INTEGER(n); int f_n_no #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS #define DEF_F_N(atom, n) DEF_F_N_1(atom, n) #else #define DEF_F_N(atom, n) DEF_F_N_0(atom, n) #endif #define LOAD_F_N_0(atom, n) LOAD_ATOM_0(atom); LOAD_INTEGER(n) #define LOAD_F_N_1(atom, n) LOAD_STR(str_##atom); LOAD_INTEGER(n);\ f_n_no = Add_F_N_Tagged(str_##atom, n) #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS #define LOAD_F_N(atom, n) LOAD_F_N_1(atom, n) #else #define LOAD_F_N(atom, n) LOAD_F_N_0(atom, n) #endif #define DEF_MP_N(m, p, n) DEF_STR(m); DEF_STR(p); DEF_INTEGER(n) #define LOAD_MP_N(m, p, n) LOAD_STR(m); LOAD_STR(p); LOAD_INTEGER(n) #define DEF_LABEL(l) char l[MAX_LABEL_LENGTH]; PlLong val_##l #define LOAD_LABEL(l) Get_Arg(top, PlLong, val_##l); \ if (val_##l==-1) strcpy(l, "0"); \ else sprintf(l, FORMAT_LABEL(val_##l)) #define Args0 ArgVal *top = arg #define Args1(a1) ArgVal *top = arg; DEF_##a1; \ LOAD_##a1 #define Args2(a1, a2) ArgVal *top = arg; DEF_##a1; DEF_##a2; \ LOAD_##a1; LOAD_##a2 #define Args3(a1, a2, a3) ArgVal *top = arg; DEF_##a1; DEF_##a2; DEF_##a3;\ LOAD_##a1; LOAD_##a2; LOAD_##a3 #define Args4(a1, a2, a3, a4) ArgVal *top = arg; \ DEF_##a1; DEF_##a2; DEF_##a3; DEF_##a4; \ LOAD_##a1; LOAD_##a2; LOAD_##a3; LOAD_##a4 #define Args5(a1, a2, a3, a4, a5) \ ArgVal *top = arg; \ DEF_##a1; DEF_##a2; DEF_##a3; DEF_##a4; DEF_##a5; \ LOAD_##a1; LOAD_##a2; LOAD_##a3; LOAD_##a4; LOAD_##a5 #define Args6(a1, a2, a3, a4, a5, a6) \ ArgVal *top = arg; \ DEF_##a1; DEF_##a2; DEF_##a3; DEF_##a4; DEF_##a5; DEF_##a6; \ LOAD_##a1; LOAD_##a2; LOAD_##a3; LOAD_##a4; LOAD_##a5; LOAD_##a6 #define FORMAT_LABEL(l) "Lpred%d_%" PL_FMT_d, cur_pred_no, (l) #define FORMAT_SUB_LABEL(sl) "Lpred%d_sub_%" PL_FMT_d, cur_pred_no, (sl) #define CREATE_CHOICE_INST(l) \ if (cur_arity >= 1 && cur_arity <= 4) \ Inst_Printf("call_c", FAST "Pl_Create_Choice_Point%d(&%s)", cur_arity, l); \ else \ Inst_Printf("call_c", FAST "Pl_Create_Choice_Point(&%s,%d)", l, cur_arity) #define UPDATE_CHOICE_INST(l) \ if (cur_arity >= 1 && cur_arity <= 4) \ Inst_Printf("call_c", FAST "Pl_Update_Choice_Point%d(&%s)", cur_arity, l); \ else \ Inst_Printf("call_c", FAST "Pl_Update_Choice_Point(&%s,%d)", l, cur_arity) #define DELETE_CHOICE_INST \ if (cur_arity >= 1 && cur_arity <= 4) \ Inst_Printf("call_c", FAST "Pl_Delete_Choice_Point%d()", cur_arity); \ else \ Inst_Printf("call_c", FAST "Pl_Delete_Choice_Point(%d)", cur_arity) /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { Parse_Arguments(argc, argv); setlocale (LC_ALL, ""); setlocale (LC_NUMERIC, "C"); /* make sure floats come out right... */ if (file_name_out == NULL) file_out = stdout; else if ((file_out = fopen(file_name_out, "wt")) == NULL) { fprintf(stderr, "cannot open output file %s\n", file_name_out); exit(1); } BT_String_Init(&bt_atom); BT_String_Init(&bt_tagged_atom); BT_String_Init(&bt_tagged_f_n); Init_Foreign_Table(); dummy_pred_start.next = NULL; dummy_direct_start.next = NULL; if (!Parse_Wam_File(file_name_in, comment)) { fprintf(stderr, "Translation aborted\n"); exit(1); } Emit_Obj_Initializer(); Emit_Exec_Directives(); if (file_out != stdout) fclose(file_out); exit(0); } /*-------------------------------------------------------------------------* * SOURCE_LINE * * * *-------------------------------------------------------------------------*/ void Source_Line(int line_no, char *cmt) { Label_Printf("\t; %6d: %s", line_no, cmt); } /*-------------------------------------------------------------------------* * F_FILE_NAME * * * *-------------------------------------------------------------------------*/ void F_file_name(ArgVal arg[]) { Args1(STR(pl_file)); cur_pl_file = BT_String_Add(&bt_atom, pl_file); } /*-------------------------------------------------------------------------* * F_PREDICATE * * * *-------------------------------------------------------------------------*/ void F_predicate(ArgVal arg[]) { BTNode *atom_module = NULL; BTNode *atom_functor; int module_user_system = 0; int prop; int local_symbol = 0; /* ArgsN macro must be last or need C99 mode (under MSVC++ use -TP) */ Args6(MP_N(module, functor, arity), INTEGER(pl_line), STR(static_dynamic), STR(public_private), STR(mono_multi), STR(built_in_local_global)); if (cur_pl_file == NULL) Syntax_Error("file_name declaration missing"); atom_functor = BT_String_Add(&bt_atom, functor); cur_arity = arity; cur_sub_label = 0; if (strcmp(static_dynamic, "dynamic") == 0) prop = MASK_PRED_DYNAMIC; else if (strcmp(static_dynamic, "static") == 0) prop = MASK_PRED_NATIVE_CODE; else Syntax_Error("static or dynamic expected"); if (strcmp(public_private, "public") == 0) prop |= MASK_PRED_PUBLIC; else if (strcmp(public_private, "private") != 0) Syntax_Error("public or private expected"); if (strcmp(mono_multi, "monofile") == 0) ; else if (strcmp(mono_multi, "multifile") == 0) { prop |= MASK_PRED_MULTIFILE; prop &= ~MASK_PRED_NATIVE_CODE; /* if multifile it needs to be emulated */ } else Syntax_Error("multifile or multifile expected"); local_symbol = 0; if (strcmp(built_in_local_global, "built_in") == 0) prop |= MASK_PRED_BUILTIN; else if (strcmp(built_in_local_global, "built_in_fd") == 0) prop |= MASK_PRED_BUILTIN_FD; else if (strcmp(built_in_local_global, "local") == 0) local_symbol = 1; else if (strcmp(built_in_local_global, "user") != 0 && strcmp(built_in_local_global, "global") != 0) Syntax_Error("built_in, built_in_fd, local or global (or user) expected"); /* 'user' is accepted for compatibility as 'global' - no longer generated */ if (!local_symbol) prop |= MASK_PRED_EXPORTED; cur_pred_no++; cur_pred = (Pred *) malloc(sizeof(Pred)); if (cur_pred == NULL) { fprintf(stderr, "Cannot allocate memory for predicate #%d (%s/%" PL_FMT_d ")\n", cur_pred_no, functor, arity); exit(1); } if (module == NULL || *module == '\0') /* 'module' is always given but in case of... */ { if (prop & MASK_PRED_BUILTIN || prop & MASK_PRED_BUILTIN_FD) module = "system"; else module = "user"; } atom_module = BT_String_Add(&bt_atom, module); if (strcmp(module, "user") == 0 || strcmp(module, "system") == 0) module_user_system = 1; cur_pred->module = atom_module; cur_pred->functor = atom_functor; cur_pred->arity = arity; cur_pred->pl_file = cur_pl_file; cur_pred->pl_line = pl_line; cur_pred->prop = prop; cur_pred->swt_tbl[0] = NULL; cur_pred->swt_tbl[1] = NULL; cur_pred->swt_tbl[2] = NULL; cur_pred->next = NULL; pred_end->next = cur_pred; pred_end = cur_pred; if (comment) { Label_Printf("\n\n; *** Predicate: %s:%s/%d (%s:%d)", module, functor, arity, cur_pl_file->str, pl_line); } /* do not qualif with module in Encode_Hexa if: * - it is not an exported predicate (i.e. it is a local_symbol) * - it owns to module 'user' or 'system' */ Encode_Hexa((local_symbol || module_user_system) ? NULL : module, functor, arity, buff_hexa + 1); *buff_hexa = '&'; cur_pred->hexa = strdup(buff_hexa); Label_Printf("\n\npl_code %s %s", (local_symbol) ? "local" : "global", buff_hexa + 1); } /*-------------------------------------------------------------------------* * F_DIRECTIVE * * * *-------------------------------------------------------------------------*/ void F_directive(ArgVal arg[]) { Direct *p; int system; /* ArgsN macro must be last or need C99 mode (under MSVC++ use -TP) */ Args2(INTEGER(pl_line), STR(user_system)); if (cur_pl_file == NULL) Syntax_Error("file_name declaration missing"); if (strcmp(user_system, "system") == 0) system = 1; else if (strcmp(user_system, "user") == 0) system = 0; else Syntax_Error("user or system expected"); cur_direct_no++; p = (Direct *) malloc(sizeof(Direct)); if (p == NULL) { fprintf(stderr, "Cannot allocate memory for directive #%d\n", cur_direct_no); exit(1); } p->pl_file = cur_pl_file; p->pl_line = pl_line; p->system = system; p->next = NULL; direct_end->next = p; direct_end = p; if (comment) Label_Printf("\n\n; *** %s Directive (%s:%d)", (system) ? "System" : "User", cur_pl_file->str, pl_line); Label_Printf("\n\npl_code local directive_%d", cur_direct_no); } /*-------------------------------------------------------------------------* * F_ENSURE_LINKED * * * *-------------------------------------------------------------------------*/ void F_ensure_linked(ArgVal arg[]) { DEF_MP_N(m, p, n); Args1(INTEGER(nb_elem)); Label_Printf("\n\npl_code local ensure_linked"); while (nb_elem--) { LOAD_MP_N(m, p, n); Encode_Hexa(m, p, n, buff_hexa); Inst_Printf("pl_jump", buff_hexa); } } /*-------------------------------------------------------------------------* * F_GET_VARIABLE * * * *-------------------------------------------------------------------------*/ void F_get_variable(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); Inst_Printf("move", "X(%" PL_FMT_d "),%c(%" PL_FMT_d ")", a, c, xy); } /*-------------------------------------------------------------------------* * F_GET_VALUE * * * *-------------------------------------------------------------------------*/ void F_get_value(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Unify(%c(%" PL_FMT_d "),X(%" PL_FMT_d "))", c, xy, a); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_GET_ATOM * * * *-------------------------------------------------------------------------*/ void F_get_atom(ArgVal arg[]) { Args2(ATOM(atom), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Get_Atom_Tagged(ta(%d),X(%" PL_FMT_d "))", atom->no, a); #else Inst_Printf("call_c", FAST "Pl_Get_Atom(at(%d),X(%" PL_FMT_d "))", atom->no, a); #endif Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_GET_INTEGER * * * *-------------------------------------------------------------------------*/ void F_get_integer(ArgVal arg[]) { Args2(INTEGER(n), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Get_Integer_Tagged(%" PL_FMT_d ",X(%" PL_FMT_d "))", Tag_INT(n), a); #else Inst_Printf("call_c", FAST "Pl_Get_Integer(%" PL_FMT_d ",X(%" PL_FMT_d "))", n, a); #endif Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_GET_FLOAT * * * *-------------------------------------------------------------------------*/ void F_get_float(ArgVal arg[]) { Args2(FLOAT(n), INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Get_Float(%1.20e,X(%" PL_FMT_d "))", n, a); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_GET_NIL * * * *-------------------------------------------------------------------------*/ void F_get_nil(ArgVal arg[]) { Args1(INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Get_Nil(X(%" PL_FMT_d "))", a); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_GET_LIST * * * *-------------------------------------------------------------------------*/ void F_get_list(ArgVal arg[]) { Args1(INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Get_List(X(%" PL_FMT_d "))", a); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_GET_STRUCTURE * * * *-------------------------------------------------------------------------*/ void F_get_structure(ArgVal arg[]) { Args2(F_N(atom, n), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Get_Structure_Tagged(fn(%d),X(%" PL_FMT_d "))", f_n_no, a); #else Inst_Printf("call_c", FAST "Pl_Get_Structure(at(%d),%" PL_FMT_d ",X(%" PL_FMT_d "))", atom->no, n, a); #endif Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_PUT_VARIABLE * * * *-------------------------------------------------------------------------*/ void F_put_variable(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); if (c == 'X') { Inst_Printf("call_c", FAST "Pl_Put_X_Variable()"); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); Inst_Printf("move", "X(%" PL_FMT_d "),X(%" PL_FMT_d ")", a, xy); } else { Inst_Printf("call_c", FAST "Pl_Put_Y_Variable(&Y(%" PL_FMT_d "))", xy); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } } /*-------------------------------------------------------------------------* * F_PUT_VOID * * * *-------------------------------------------------------------------------*/ void F_put_void(ArgVal arg[]) { Args1(INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Put_X_Variable()"); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_VALUE * * * *-------------------------------------------------------------------------*/ void F_put_value(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); Inst_Printf("move", "%c(%" PL_FMT_d "),X(%" PL_FMT_d ")", c, xy, a); } /*-------------------------------------------------------------------------* * F_PUT_UNSAFE_VALUE * * * *-------------------------------------------------------------------------*/ void F_put_unsafe_value(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Put_Unsafe_Value(%c(%" PL_FMT_d "))", c, xy); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_ATOM * * * *-------------------------------------------------------------------------*/ void F_put_atom(ArgVal arg[]) { Args2(ATOM(atom), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Put_Atom_Tagged(ta(%d))", atom->no); #else Inst_Printf("call_c", FAST "Pl_Put_Atom(at(%d))", atom->no); #endif Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_INTEGER * * * *-------------------------------------------------------------------------*/ void F_put_integer(ArgVal arg[]) { Args2(INTEGER(n), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Put_Integer_Tagged(%" PL_FMT_d ")", Tag_INT(n)); #else Inst_Printf("call_c", FAST "Pl_Put_Integer(%" PL_FMT_d ")", n); #endif Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_FLOAT * * * *-------------------------------------------------------------------------*/ void F_put_float(ArgVal arg[]) { Args2(FLOAT(n), INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Put_Float(%1.20e)", n); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_NIL * * * *-------------------------------------------------------------------------*/ void F_put_nil(ArgVal arg[]) { Args1(INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Put_Nil()"); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_LIST * * * *-------------------------------------------------------------------------*/ void F_put_list(ArgVal arg[]) { Args1(INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Put_List()"); Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_STRUCTURE * * * *-------------------------------------------------------------------------*/ void F_put_structure(ArgVal arg[]) { Args2(F_N(atom, n), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Put_Structure_Tagged(fn(%d))", f_n_no); #else Inst_Printf("call_c", FAST "Pl_Put_Structure(at(%d),%" PL_FMT_d ")", atom->no, n); #endif Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_PUT_META_TERM * * * *-------------------------------------------------------------------------*/ void F_put_meta_term(ArgVal arg[]) { Args3(ATOM(module), INTEGER(x), INTEGER(a)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Put_Meta_Term_Tagged(ta(%d), X(%" PL_FMT_d "))", module->no, x); #else Inst_Printf("call_c", FAST "Pl_Put_Meta_Term(at(%d), X(%" PL_FMT_d "))", module->no, x); #endif Inst_Printf("move_ret", "X(%" PL_FMT_d ")", a); } /*-------------------------------------------------------------------------* * F_MATH_LOAD_VALUE * * * *-------------------------------------------------------------------------*/ void F_math_load_value(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Math_Load_Value(%c(%" PL_FMT_d "),&X(%" PL_FMT_d "))", c, xy, a); } /*-------------------------------------------------------------------------* * F_MATH_FAST_LOAD_VALUE * * * *-------------------------------------------------------------------------*/ void F_math_fast_load_value(ArgVal arg[]) { Args2(X_Y(xy), INTEGER(a)); Inst_Printf("call_c", FAST "Pl_Math_Fast_Load_Value(%c(%" PL_FMT_d "),&X(%" PL_FMT_d "))", c, xy, a); } /*-------------------------------------------------------------------------* * F_UNIFY_VARIABLE * * * *-------------------------------------------------------------------------*/ void F_unify_variable(ArgVal arg[]) { Args1(X_Y(xy)); Inst_Printf("call_c", FAST "Pl_Unify_Variable()"); Inst_Printf("move_ret", "%c(%" PL_FMT_d ")", c, xy); } /*-------------------------------------------------------------------------* * F_UNIFY_VOID * * * *-------------------------------------------------------------------------*/ void F_unify_void(ArgVal arg[]) { Args1(INTEGER(n)); Inst_Printf("call_c", FAST "Pl_Unify_Void(%" PL_FMT_d ")", n); } /*-------------------------------------------------------------------------* * F_UNIFY_VALUE * * * *-------------------------------------------------------------------------*/ void F_unify_value(ArgVal arg[]) { Args1(X_Y(xy)); Inst_Printf("call_c", FAST "Pl_Unify_Value(%c(%" PL_FMT_d "))", c, xy); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_UNIFY_LOCAL_VALUE * * * *-------------------------------------------------------------------------*/ void F_unify_local_value(ArgVal arg[]) { Args1(X_Y(xy)); Inst_Printf("call_c", FAST "Pl_Unify_Local_Value(%c(%" PL_FMT_d "))", c, xy); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_UNIFY_ATOM * * * *-------------------------------------------------------------------------*/ void F_unify_atom(ArgVal arg[]) { Args1(ATOM(atom)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Unify_Atom_Tagged(ta(%d))", atom->no); #else Inst_Printf("call_c", FAST "Pl_Unify_Atom(at(%d))", atom->no); #endif Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_UNIFY_INTEGER * * * *-------------------------------------------------------------------------*/ void F_unify_integer(ArgVal arg[]) { Args1(INTEGER(n)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Unify_Integer_Tagged(%" PL_FMT_d ")", Tag_INT(n)); #else Inst_Printf("call_c", FAST "Pl_Unify_Integer(%" PL_FMT_d ")", n); #endif Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_UNIFY_NIL * * * *-------------------------------------------------------------------------*/ void F_unify_nil(ArgVal arg[]) { Inst_Printf("call_c", FAST "Pl_Unify_Nil()"); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_UNIFY_LIST * * * *-------------------------------------------------------------------------*/ void F_unify_list(ArgVal arg[]) { Inst_Printf("call_c", FAST "Pl_Unify_List()"); Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_UNIFY_STRUCTURE * * * *-------------------------------------------------------------------------*/ void F_unify_structure(ArgVal arg[]) { Args1(F_N(atom, n)); #ifdef USE_TAGGED_CALLS_FOR_WAM_FCTS Inst_Printf("call_c", FAST "Pl_Unify_Structure_Tagged(fn(%d))", f_n_no); #else Inst_Printf("call_c", FAST "Pl_Unify_Structure(at(%d),%" PL_FMT_d ")", atom->no, n); #endif Inst_Printf("fail_ret", ""); } /*-------------------------------------------------------------------------* * F_ALLOCATE * * * *-------------------------------------------------------------------------*/ void F_allocate(ArgVal arg[]) { Args1(INTEGER(n)); Inst_Printf("call_c", FAST "Pl_Allocate(%" PL_FMT_d ")", n); } /*-------------------------------------------------------------------------* * F_DEALLOCATE * * * *-------------------------------------------------------------------------*/ void F_deallocate(ArgVal arg[]) { Inst_Printf("call_c", FAST "Pl_Deallocate()"); } /*-------------------------------------------------------------------------* * F_CALL * * * *-------------------------------------------------------------------------*/ void F_call(ArgVal arg[]) { Args1(MP_N(m, p, n)); Encode_Hexa(m, p, n, buff_hexa); Inst_Printf("pl_call", buff_hexa); } /*-------------------------------------------------------------------------* * F_EXECUTE * * * *-------------------------------------------------------------------------*/ void F_execute(ArgVal arg[]) { Args1(MP_N(m, p, n)); Encode_Hexa(m, p, n, buff_hexa); Inst_Printf("pl_jump", buff_hexa); } /*-------------------------------------------------------------------------* * F_PROCEED * * * *-------------------------------------------------------------------------*/ void F_proceed(ArgVal arg[]) { Inst_Printf("pl_ret", ""); } /*-------------------------------------------------------------------------* * F_FAIL * * * *-------------------------------------------------------------------------*/ void F_fail(ArgVal arg[]) { Inst_Printf("pl_fail", ""); } /*-------------------------------------------------------------------------* * F_LABEL * * * *-------------------------------------------------------------------------*/ void F_label(ArgVal arg[]) { Args1(LABEL(l)); Label_Printf("\n%s:", l); } /*-------------------------------------------------------------------------* * F_SWITCH_ON_TERM * * * *-------------------------------------------------------------------------*/ void F_switch_on_term(ArgVal arg[]) { #define NB_SWT_LIST 5 #define LVAR 1 #define LATM 2 #define LINT 4 #define LLST 8 #define LSTC 16 Args0; DEF_INTEGER(val_label); static char l[NB_SWT_LIST][MAX_LABEL_LENGTH]; int mask = 0, i; for (i = 0; i < NB_SWT_LIST; i++) { LOAD_INTEGER(val_label); if (val_label == -1) strcpy(l[i], "0"); else { sprintf(l[i], "&" FORMAT_LABEL(val_label)); mask |= (1 << i); } } switch(mask) /* some specialized functions */ { case LVAR | LATM: Inst_Printf("call_c", FAST "Pl_Switch_On_Term_Var_Atm(%s,%s)", l[0], l[1]); break; case LVAR | LSTC: Inst_Printf("call_c", FAST "Pl_Switch_On_Term_Var_Stc(%s,%s)", l[0], l[4]); break; case LVAR | LATM | LLST: Inst_Printf("call_c", FAST "Pl_Switch_On_Term_Var_Atm_Lst(%s,%s,%s)", l[0], l[1], l[3]); break; case LVAR | LATM | LSTC: Inst_Printf("call_c", FAST "Pl_Switch_On_Term_Var_Atm_Stc(%s,%s,%s)", l[0], l[1], l[4]); break; default: Inst_Printf("call_c", FAST "Pl_Switch_On_Term(%s,%s,%s,%s,%s)", l[0], l[1], l[2], l[3], l[4]); break; } Inst_Printf("jump_ret", ""); } /*-------------------------------------------------------------------------* * CREATE_SWITCH_TABLE * * * *-------------------------------------------------------------------------*/ SwtTbl * Create_Switch_Table(int type, int nb_elem) { SwtTbl *t; t = (SwtTbl *) malloc(sizeof(SwtTbl) + sizeof(SwtElt) * (nb_elem - 1)); if (t == NULL) { fprintf(stderr, "Cannot allocate memory for switch table\n"); exit(1); } t->type = type; t->tbl_no = nb_swt_tbl++; t->next = cur_pred->swt_tbl[type]; t->nb_elem = nb_elem; cur_pred->swt_tbl[type] = t; return t; } /*-------------------------------------------------------------------------* * F_SWITCH_ON_ATOM * * * *-------------------------------------------------------------------------*/ void F_switch_on_atom(ArgVal arg[]) { SwtTbl *t; SwtElt *elem; DEF_STR(str); DEF_INTEGER(label); Args1(INTEGER(nb_elem)); t = Create_Switch_Table(TBL_ATM, nb_elem); for (elem = t->elem; nb_elem--; elem++) { LOAD_STR(str); LOAD_INTEGER(label); elem->atom = BT_String_Add(&bt_atom, str); elem->label = label; } Inst_Printf("call_c", FAST "Pl_Switch_On_Atom(st(%d),%d)", nb_swt_tbl - 1, t->nb_elem); Inst_Printf("jump_ret", ""); } /*-------------------------------------------------------------------------* * F_SWITCH_ON_INTEGER * * * *-------------------------------------------------------------------------*/ void F_switch_on_integer(ArgVal arg[]) { #ifdef SWT_INT_NO_OPT SwtTbl *t; SwtElt *elem; DEF_INTEGER(n); DEF_INTEGER(label); Args1(INTEGER(nb_elem)); t = Create_Switch_Table(TBL_INT, nb_elem); for (elem = t->elem; nb_elem--; elem++) { LOAD_INTEGER(n); LOAD_INTEGER(label); elem->n = n; elem->label = label; } Inst_Printf("call_c", FAST "Pl_Switch_On_Integer(st(%d),%d)", nb_swt_tbl - 1, t->nb_elem); Inst_Printf("jump_ret", ""); #else char c; DEF_INTEGER(n); DEF_LABEL(l); Args1(INTEGER(nb_elem)); Inst_Printf("call_c", FAST "Pl_Switch_On_Integer()"); Inst_Printf("switch_ret", NULL); /* NULL to avoid newline */ c = '('; while (nb_elem--) { LOAD_INTEGER(n); LOAD_LABEL(l); fprintf(file_out, "%c%" PL_FMT_d "=%s", c, n, l); c = ','; } fprintf(file_out, ")\n"); #endif } /*-------------------------------------------------------------------------* * F_SWITCH_ON_STRUCTURE * * * *-------------------------------------------------------------------------*/ void F_switch_on_structure(ArgVal arg[]) { SwtTbl *t; SwtElt *elem; DEF_STR(str); DEF_INTEGER(arity); DEF_INTEGER(label); Args1(INTEGER(nb_elem)); t = Create_Switch_Table(TBL_STC, nb_elem); for (elem = t->elem; nb_elem--; elem++) { LOAD_STR(str); LOAD_INTEGER(arity); LOAD_INTEGER(label); elem->atom = BT_String_Add(&bt_atom, str); elem->n = arity; elem->label = label; } Inst_Printf("call_c", FAST "Pl_Switch_On_Structure(st(%d),%d)", nb_swt_tbl - 1, t->nb_elem); Inst_Printf("jump_ret", ""); } /*-------------------------------------------------------------------------* * F_TRY_ME_ELSE * * * *-------------------------------------------------------------------------*/ void F_try_me_else(ArgVal arg[]) { Args1(LABEL(l)); CREATE_CHOICE_INST(l); } /*-------------------------------------------------------------------------* * F_RETRY_ME_ELSE * * * *-------------------------------------------------------------------------*/ void F_retry_me_else(ArgVal arg[]) { Args1(LABEL(l)); UPDATE_CHOICE_INST(l); } /*-------------------------------------------------------------------------* * F_TRUST_ME_ELSE_FAIL * * * *-------------------------------------------------------------------------*/ void F_trust_me_else_fail(ArgVal arg[]) { DELETE_CHOICE_INST; } /*-------------------------------------------------------------------------* * F_TRY * * * *-------------------------------------------------------------------------*/ void F_try(ArgVal arg[]) { char sl[MAX_LABEL_LENGTH]; Args1(LABEL(l)); sprintf(sl, FORMAT_SUB_LABEL(cur_sub_label++)); CREATE_CHOICE_INST(sl); Inst_Printf("jump", "%s", l); Label_Printf("%s:", sl); } /*-------------------------------------------------------------------------* * F_RETRY * * * *-------------------------------------------------------------------------*/ void F_retry(ArgVal arg[]) { char sl[MAX_LABEL_LENGTH]; Args1(LABEL(l)); sprintf(sl, FORMAT_SUB_LABEL(cur_sub_label++)); UPDATE_CHOICE_INST(sl); Inst_Printf("jump", "%s", l); Label_Printf("%s:", sl); } /*-------------------------------------------------------------------------* * F_TRUST * * * *-------------------------------------------------------------------------*/ void F_trust(ArgVal arg[]) { Args1(LABEL(l)); DELETE_CHOICE_INST; Inst_Printf("jump", "%s", l); } /*-------------------------------------------------------------------------* * F_PRAGMA_ARITY * * * *-------------------------------------------------------------------------*/ void F_pragma_arity(ArgVal arg[]) { Args1(INTEGER(a)); /* Used for for a pred/arity with cuts (not soft cuts). * Since the cut level is stored in X(arity) we have to save it in choice-points * This pragma adjusts the number of args to save in choice-points. */ cur_arity = a; } /*-------------------------------------------------------------------------* * F_GET_CURRENT_CHOICE * * * *-------------------------------------------------------------------------*/ void F_get_current_choice(ArgVal arg[]) { Args1(X_Y(xy)); Inst_Printf("call_c", FAST "Pl_Get_Current_Choice()"); Inst_Printf("move_ret", "%c(%" PL_FMT_d ")", c, xy); } /*-------------------------------------------------------------------------* * F_CUT * * * *-------------------------------------------------------------------------*/ void F_cut(ArgVal arg[]) { Args1(X_Y(xy)); Inst_Printf("call_c", FAST "Pl_Cut(%c(%" PL_FMT_d "))", c, xy); } /*-------------------------------------------------------------------------* * F_CUT * * * *-------------------------------------------------------------------------*/ void F_soft_cut(ArgVal arg[]) { Args1(X_Y(xy)); Inst_Printf("call_c", FAST "Pl_Soft_Cut(%c(%" PL_FMT_d "))", c, xy); } /*-------------------------------------------------------------------------* * F_CALL_C * * * * call_c(F, [T,...], [W,...]) * * F=FctName, T=option only these options are relevant: * * - jump/boolean/x(X) (jump at / test / move returned value) * * - set_cp (set CP before the call at the next instruction) * * - fast_call (use a fact call convention) * * - tagged (use tagged calls for atoms, integers and F/N) * * W= atom &,fun,arity integer double x(X) y(Y) &,x(X) &,y(Y) * *-------------------------------------------------------------------------*/ void F_call_c(ArgVal arg[]) { int ret = 0; /* 1: boolean, 2: jump, 3: move */ int fast_call = 0; int tagged = 0; int set_cp = 0; char *str; int adr_of; PlLong ret_xy; char ret_c; int i; DEF_STR(c_option); DEF_INTEGER(arg_type); DEF_ATOM(atom); DEF_STR(aux_functor); DEF_INTEGER(aux_arity); DEF_INTEGER(n); DEF_FLOAT(n1); DEF_X_Y(xy); Args2(STR(fct_name), INTEGER(nb_elem)); for (i = 0; i < nb_elem; i++) { LOAD_INTEGER(arg_type); if (arg_type == X_Y) /* move_ret x(X) (or y(Y) but not used) */ { LOAD_X_Y(xy); ret = 3; ret_xy = xy; ret_c = c; continue; } /* else should be ATOM */ LOAD_STR(c_option); if (strcmp(c_option, "boolean") == 0) ret = 1; else if (strcmp(c_option, "jump") == 0) ret = 2; else if (strcmp(c_option, "fast_call") == 0) fast_call = 1; else if (strcmp(c_option, "tagged") == 0) tagged = 1; else if (strcmp(c_option, "set_cp") == 0) set_cp = 1; } LOAD_INTEGER(nb_elem); if (set_cp) Inst_Printf("prep_cp", ""); Inst_Printf("call_c", NULL); if (fast_call) fputs(FAST "", file_out); fprintf(file_out, "%s(", fct_name); i = 0; adr_of = 0; goto write_a_arg; while(i < nb_elem) { fputc(',', file_out); write_a_arg: LOAD_INTEGER(arg_type); switch(arg_type) { case ATOM: /* detect &,func,arity &,x(X) &,y(Y) */ str = *((char **) top); if (*str == '&' && str[1] == '\0') { if ((i < nb_elem - 1 && *(PlLong *) (top+1) == X_Y) || (i < nb_elem - 2 && *(PlLong *) (top+1) == ATOM && *(PlLong *) (top+3) == INTEGER)) { adr_of = 1; i++; top++; goto write_a_arg; } } if (adr_of) { LOAD_STR(aux_functor); i++; top++; LOAD_INTEGER(aux_arity); Encode_Hexa(NULL, aux_functor, aux_arity, buff_hexa); fprintf(file_out, "&%s", buff_hexa); adr_of = 0; } else if (tagged) { LOAD_ATOM_1(atom); fprintf(file_out, "ta(%d)", atom->no); } else { LOAD_ATOM_0(atom); fprintf(file_out, "at(%d)", atom->no); } break; case INTEGER: LOAD_INTEGER(n); fprintf(file_out, "%" PL_FMT_d, (tagged) ? Tag_INT(n) : n); break; case FLOAT: LOAD_FLOAT(n1); fprintf(file_out, "%1.20e", n1); break; case X_Y: LOAD_X_Y(xy); if (adr_of) { fprintf(file_out, "&"); adr_of = 0; } fprintf(file_out, "%c(%" PL_FMT_d ")", c, xy); break; case F_N: if (tagged) { DEF_F_N_1(atom, n); LOAD_F_N_1(atom, n); fprintf(file_out, "fn(%d)", f_n_no); } else { DEF_F_N_0(atom, n); LOAD_F_N_0(atom, n); fprintf(file_out, "at(%d),%" PL_FMT_d "", atom->no, n); } break; } i++; } fprintf(file_out, ")\n"); if (ret == 1) Inst_Printf("fail_ret", ""); else if (ret == 2) Inst_Printf("jump_ret", ""); else if (ret == 3) Inst_Printf("move_ret", "%c(%" PL_FMT_d ")", ret_c, ret_xy); if (set_cp) Inst_Printf("here_cp", ""); } /*-------------------------------------------------------------------------* * INIT_FOREIGN_TABLE * * * *-------------------------------------------------------------------------*/ void Init_Foreign_Table(void) { foreign_tbl[FOREIGN_TYPE_INTEGER] = "Integer"; foreign_tbl[FOREIGN_TYPE_POSITIVE] = "Positive"; foreign_tbl[FOREIGN_TYPE_FLOAT] = "Float"; foreign_tbl[FOREIGN_TYPE_NUMBER] = "Number"; foreign_tbl[FOREIGN_TYPE_ATOM] = "Atom"; foreign_tbl[FOREIGN_TYPE_BOOLEAN] = "Boolean"; foreign_tbl[FOREIGN_TYPE_CHAR] = "Char"; foreign_tbl[FOREIGN_TYPE_IN_CHAR] = "In_Char"; foreign_tbl[FOREIGN_TYPE_CODE] = "Code"; foreign_tbl[FOREIGN_TYPE_IN_CODE] = "In_Code"; foreign_tbl[FOREIGN_TYPE_BYTE] = "Byte"; foreign_tbl[FOREIGN_TYPE_IN_BYTE] = "In_Byte"; foreign_tbl[FOREIGN_TYPE_STRING] = "String"; foreign_tbl[FOREIGN_TYPE_CHARS] = "Chars"; foreign_tbl[FOREIGN_TYPE_CODES] = "Codes"; foreign_tbl[FOREIGN_TYPE_TERM] = "Term"; } /*-------------------------------------------------------------------------* * F_FOREIGN_CALL_C * * * * foreign_call_c(F, T0, P/N, K, [(M1, T1),...]) * * F=FctName, T0=Return, P/N=BipName/BipArity, K=ChcSize * * Mi=mode (in/out/in_out), Ti=type * *-------------------------------------------------------------------------*/ void F_foreign_call_c(ArgVal arg[]) #define F_Double(t) ((t)==FOREIGN_TYPE_FLOAT || (t)==FOREIGN_TYPE_NUMBER) #define F_Array_Letter(t) (F_Double(t) ? 'D' : 'L') { static int mode[NB_OF_X_REGS], type[NB_OF_X_REGS]; int i, j, n, fio_arg_index = 0, nb_c_str = 0, s_dup, complex_jump_ret = 0; char c; char l[MAX_LABEL_LENGTH]; DEF_STR(str_mode); DEF_STR(str_type); Args6(STR(fct_name), STR(ret_mode), STR(bip_name), INTEGER(bip_arity), INTEGER(chc_size), INTEGER(nb_elem)); for (i = 0; i < nb_elem; i++) { LOAD_STR(str_mode); LOAD_STR(str_type); if (strcmp(str_mode, "in") == 0) mode[i] = FOREIGN_MODE_IN; else if (strcmp(str_mode, "out") == 0) mode[i] = FOREIGN_MODE_OUT; else if (strcmp(str_mode, "in_out") == 0) mode[i] = FOREIGN_MODE_IN_OUT; j = 0; for (;;) if (strcasecmp(foreign_tbl[j], str_type) == 0) break; else if (++j >= FOREIGN_TBL_SIZE) { fprintf(stderr, "invalid foreign type:%s\n", str_type); exit(1); } type[i] = j; if ((mode[i] == FOREIGN_MODE_IN || mode[i] == FOREIGN_MODE_IN_OUT) && (j == FOREIGN_TYPE_CHARS || j == FOREIGN_TYPE_CODES)) nb_c_str++; } if (chc_size >= 0) { sprintf(l, FORMAT_LABEL((PlLong)1)); Inst_Printf("call_c", "Pl_Foreign_Create_Choice(&%s,%d,%" PL_FMT_d ")", l, cur_arity, chc_size); Label_Printf("%s:", l); Inst_Printf("call_c", "Pl_Foreign_Update_Choice(&%s,%d,%" PL_FMT_d ")", l, cur_arity, chc_size); } if (*bip_name || bip_arity != -2) Inst_Printf("call_c", "Pl_Set_C_Bip_Name(\"%s\",%" PL_FMT_d ")", bip_name, bip_arity); for (i = 0; i < nb_elem; i++) { n = type[i]; c = F_Array_Letter(n); s_dup = (mode[i] == FOREIGN_MODE_IN || mode[i] == FOREIGN_MODE_IN_OUT) && (n == FOREIGN_TYPE_CHARS || n == FOREIGN_TYPE_CODES) && --nb_c_str != 0; switch (mode[i]) { case FOREIGN_MODE_IN: if (n != FOREIGN_TYPE_TERM) { Inst_Printf("call_c", "Pl_Rd_%s_Check(X(%d))", foreign_tbl[n], i); Inst_Printf("move_ret", "F%c(%d)", c, i); if (s_dup) { Inst_Printf("call_c", "Pl_Strdup_Check(FL(%d),\"call generated by %s\",%d)", i, __FILE__, __LINE__); Inst_Printf("move_ret", "FL(%d)", i); } } break; case FOREIGN_MODE_OUT: complex_jump_ret = 1; /* arg to unif. complex jump_ret */ if (n != FOREIGN_TYPE_TERM) Inst_Printf("call_c", "Pl_Check_For_Un_%s(X(%d))", foreign_tbl[n], i); break; case FOREIGN_MODE_IN_OUT: complex_jump_ret = 1; /* arg to unif. complex jump_ret */ if (n != FOREIGN_TYPE_TERM) Inst_Printf("call_c", "Pl_Foreign_Rd_IO_Arg(%d,X(%d)," "&Pl_Rd_%s_Check,%d)", (c == 'L') + s_dup, /* 0,1 or 2 if strdup */ i, foreign_tbl[n], fio_arg_index++); else Inst_Printf("call_c", "Pl_Foreign_Rd_IO_Arg(1,X(%d),0,%d)", i, fio_arg_index++); Inst_Printf("move_ret", "FL(%d)", i); break; } } Inst_Printf("call_c", NULL); fprintf(file_out, "%s(", fct_name); for (i = 0; i < nb_elem; i++) { n = type[i]; c = (mode[i] == FOREIGN_MODE_IN_OUT) ? 'L' : F_Array_Letter(n); if (i > 0) fputc(',', file_out); if (mode[i] == FOREIGN_MODE_OUT) fprintf(file_out, "&"); if (n == FOREIGN_TYPE_TERM && mode[i] == FOREIGN_MODE_IN) fprintf(file_out, "X(%d)", i); else fprintf(file_out, "F%c(%d)", c, i); } fprintf(file_out, ")\n"); if (strcmp(ret_mode, "jump") == 0) { if (!complex_jump_ret) Inst_Printf("jump_ret", ""); else Inst_Printf("move_ret", "FL(%d)", NB_OF_X_REGS - 1); } else { complex_jump_ret = 0; if (strcmp(ret_mode, "boolean") == 0) Inst_Printf("fail_ret", ""); } for (i = 0; i < nb_elem; i++) { n = type[i]; c = F_Array_Letter(type[i]); switch (mode[i]) { case FOREIGN_MODE_OUT: if (n != FOREIGN_TYPE_TERM) Inst_Printf("call_c", "Pl_Un_%s(F%c(%d),X(%d))", foreign_tbl[n], c, i, i); else Inst_Printf("call_c", FAST "Pl_Unify(X(%d),FL(%d))", i, i); Inst_Printf("fail_ret", ""); break; case FOREIGN_MODE_IN_OUT: Inst_Printf("call_c", "Pl_Foreign_Un_IO_Arg(%d,&Pl_Un_%s,FL(%d)," "X(%d))", c == 'L', foreign_tbl[n], i, i); Inst_Printf("fail_ret", ""); break; } } if (complex_jump_ret) { Inst_Printf("call_c", "Pl_Foreign_Jump_Ret(FL(%d))", NB_OF_X_REGS - 1); Inst_Printf("jump_ret", ""); } } /*-------------------------------------------------------------------------* * EMIT_OBJ_INITIALIZER * * * *-------------------------------------------------------------------------*/ void Emit_Obj_Initializer(void) { SwtTbl *t; Pred *p; int i, j; char l[MAX_LABEL_LENGTH]; char *q; Label_Printf("\n"); if (bt_atom.nb_elem) Label_Printf("long local at(%d)", bt_atom.nb_elem); if (bt_tagged_atom.nb_elem) Label_Printf("long local ta(%d)", bt_tagged_atom.nb_elem); if (bt_tagged_f_n.nb_elem) Label_Printf("long local fn(%d)", bt_tagged_f_n.nb_elem); if (nb_swt_tbl) Label_Printf("long local st(%d)", nb_swt_tbl); Label_Printf("\n"); Label_Printf("c_code initializer Object_Initializer\n"); Inst_Printf("call_c", "Pl_New_Object(&Prolog_Object_Initializer,&System_Directives,&User_Directives)"); Inst_Printf("c_ret", ""); Label_Printf("\n"); Label_Printf("c_code local Prolog_Object_Initializer\n"); #ifdef DEBUG Inst_Printf("call_c", "printf(\"executing init obj of %s\\n\")", file_name_in); #endif BT_String_List(&bt_atom, Emit_One_Atom); BT_String_List(&bt_tagged_atom, Emit_One_Atom_Tagged); BT_String_List(&bt_tagged_f_n, Emit_One_F_N_Tagged); cur_pred_no = 0; for (p = dummy_pred_start.next; p; p = p->next) { fputc('\n', file_out); if (p->prop & MASK_PRED_NATIVE_CODE) q = p->hexa; else q = "0"; #if 1 /* uncomment this to support modules */ Inst_Printf("call_c", FAST "Pl_Create_Pred(at(%d),at(%d),%d,at(%d),%d,%d,%s)", p->module->no, p->functor->no, p->arity, p->pl_file->no, p->pl_line, p->prop, q); #else Inst_Printf("call_c", FAST "Pl_Create_Pred(at(%d),%d,at(%d),%d,%d,%s)", p->functor->no, p->arity, p->pl_file->no, p->pl_line, p->prop, q); #endif cur_pred_no++; /* for FORMAT_LABEL */ for (i = 0; i < 3; i++) for (t = p->swt_tbl[i]; t != NULL; t = t->next) { Inst_Printf("call_c", FAST "Pl_Create_Swt_Table(%d)", t->nb_elem); Inst_Printf("move_ret", "st(%d)", t->tbl_no); switch (i) { case TBL_ATM: for (j = 0; j < t->nb_elem; j++) { sprintf(l, FORMAT_LABEL(t->elem[j].label)); Inst_Printf("call_c", FAST "Pl_Create_Swt_Atm_Element(st(%d),%d,at(%d),&%s)", t->tbl_no, t->nb_elem, (t->elem[j].atom)->no, l); } break; #ifdef SWT_INT_NO_OPT case TBL_INT: for (j = 0; j < t->nb_elem; j++) { sprintf(l, FORMAT_LABEL(t->elem[j].label)); Inst_Printf("call_c", FAST "Pl_Create_Swt_Int_Element(st(%d),%d,%" PL_FMT_d ",&%s)", t->tbl_no, t->nb_elem, t->elem[j].n, l); } break; #endif default: for (j = 0; j < t->nb_elem; j++) { sprintf(l, FORMAT_LABEL(t->elem[j].label)); Inst_Printf("call_c", FAST "Pl_Create_Swt_Stc_Element(st(%d),%d,at(%d),%" PL_FMT_d ",&%s)", t->tbl_no, t->nb_elem, (t->elem[j].atom)->no, t->elem[j].n, l); } } } } Inst_Printf("c_ret", ""); } /*-------------------------------------------------------------------------* * EMIT_EXEC_DIRECTIVES * * * *-------------------------------------------------------------------------*/ void Emit_Exec_Directives(void) { int i; Direct *p; fputc('\n', file_out); Label_Printf("c_code local System_Directives\n"); i = 0; for (p = dummy_direct_start.next; p; p = p->next) { i++; if (!p->system) continue; #ifdef DEBUG { static int flag = 0; if (!flag) Inst_Printf("call_c", "printf(\"executing syst directives of %s\\n\")", file_name_in); flag = 1; } #endif Inst_Printf("call_c", "Pl_Execute_Directive(at(%d),%d,%d,&directive_%d)", p->pl_file->no, p->pl_line, 1, i); } Inst_Printf("c_ret", ""); fputc('\n', file_out); Label_Printf("c_code local User_Directives\n"); i = 0; for (p = dummy_direct_start.next; p; p = p->next) { i++; if (p->system) continue; #ifdef DEBUG { static int flag = 0; if (!flag) Inst_Printf("call_c", "printf(\"executing user directives of %s\\n\")", file_name_in); flag = 1; } #endif Inst_Printf("call_c", "Pl_Execute_Directive(at(%d),%d,%d,&directive_%d)", p->pl_file->no, p->pl_line, 0, i); } Inst_Printf("c_ret", ""); } /*-------------------------------------------------------------------------* * EMIT_ONE_ATOM * * * *-------------------------------------------------------------------------*/ void Emit_One_Atom(int no, char *str, void *info) { Inst_Printf("call_c", "Pl_Create_Atom(\"%s\")", str); Inst_Printf("move_ret", "at(%d)", no); } /*-------------------------------------------------------------------------* * EMIT_ONE_ATOM_TAGGED * * * *-------------------------------------------------------------------------*/ void Emit_One_Atom_Tagged(int no, char *str, void *info) { BTNode *atom = BT_String_Lookup(&bt_atom, str); if (atom) /* optim: reuse the atom to avoid re-hashing */ Inst_Printf("call_c", FAST "Pl_Put_Atom(at(%d))", atom->no); else Inst_Printf("call_c", FAST "Pl_Create_Atom_Tagged(\"%s\")", str); Inst_Printf("move_ret", "ta(%d)", no); } /*-------------------------------------------------------------------------* * ADD_F_N_TAGGED * * * *-------------------------------------------------------------------------*/ int Add_F_N_Tagged(char *atom, int n) { int l = strlen(atom); atom = (char *) realloc(atom, l + 5 + 1); sprintf(atom + l, "/%d", n); return BT_String_Add(&bt_tagged_f_n, atom)->no; } /*-------------------------------------------------------------------------* * EMIT_ONE_F_N_TAGGED * * * *-------------------------------------------------------------------------*/ void Emit_One_F_N_Tagged(int no, char *str, void *info) { int n; char *p = str + strlen(str) - 1; for(p = str + strlen(str) - 1; *p != '/'; p--) ; n = atoi(p+1); *p = '\0'; Inst_Printf("call_c", FAST "Pl_Create_Functor_Arity_Tagged(\"%s\",%d)", str, n); Inst_Printf("move_ret", "fn(%d)", no); } /*-------------------------------------------------------------------------* * LABEL_PRINTF * * * *-------------------------------------------------------------------------*/ void Label_Printf(char *label, ...) { va_list arg_ptr; va_start(arg_ptr, label); vfprintf(file_out, label, arg_ptr); va_end(arg_ptr); fputc('\n', file_out); } /*-------------------------------------------------------------------------* * INST_PRINTF * * * *-------------------------------------------------------------------------*/ void Inst_Printf(char *op, char *operands, ...) { va_list arg_ptr; va_start(arg_ptr, operands); fprintf(file_out, "\t%-10s ", op); if (operands) { vfprintf(file_out, operands, arg_ptr); fputc('\n', file_out); } va_end(arg_ptr); } /*-------------------------------------------------------------------------* * PARSE_ARGUMENTS * * * *-------------------------------------------------------------------------*/ void Parse_Arguments(int argc, char *argv[]) { static char str[1024]; int i; file_name_in = file_name_out = NULL; comment = 0; for (i = 1; i < argc; i++) { if (*argv[i] == '-' && argv[i][1] != '\0') { if (Check_Arg(i, "-o") || Check_Arg(i, "--output")) { if (++i >= argc) { fprintf(stderr, "FILE missing after %s option\n", argv[i - 1]); exit(1); } file_name_out = argv[i]; continue; } if (Check_Arg(i, "--comment")) { comment = 1; continue; } if (Check_Arg(i, "--version")) { Display_Copying("WAM to Mini-Assembly Compiler"); exit(0); } if (Check_Arg(i, "-h") || Check_Arg(i, "--help")) { Display_Help(); exit(0); } fprintf(stderr, "unknown option %s - try wam2ma --help\n", argv[i]); exit(1); } if (file_name_in != NULL) { fprintf(stderr, "input file already specified (%s)\n", file_name_in); exit(1); } file_name_in = argv[i]; } if (file_name_in != NULL && strcmp(file_name_in, "-") == 0) file_name_in = NULL; if (file_name_out == NULL && file_name_in != NULL) { strcpy(str, file_name_in); i = strlen(str); if (strcmp(str + i - 4, ".wam") == 0) strcpy(str + i - 4, DEFAULT_OUTPUT_SUFFIX); else strcpy(str + i, DEFAULT_OUTPUT_SUFFIX); file_name_out = str; } if (file_name_out != NULL && strcmp(file_name_out, "-") == 0) file_name_out = NULL; } /*-------------------------------------------------------------------------* * DISPLAY_HELP * * * *-------------------------------------------------------------------------*/ void Display_Help(void) #define L(msg) fprintf(stderr, "%s\n", msg) { L("Usage: wam2ma [OPTION...] FILE"); L(""); L("Options:"); L(" -o FILE, --output FILE set output file name"); L(" --comment include comments in the output file"); L(" -h, --help print this help and exit"); L(" --version print version number and exit"); L(""); L("'-' can be given as FILE for the standard input/output"); L(""); L("Report bugs to bug-prolog@gnu.org."); } #undef L ��������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/wam_parser.h���������������������������������������������������������������0000644�0001750�0001750�00000010016�13021324543�015501� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : WAM to mini-assembler translator * * File : wam_parser.h * * Descr.: parser - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef enum { /* skip 256 to specify a given char */ ATOM = 256, /* an atom */ INTEGER, /* an integer */ FLOAT, /* a double */ X_Y, /* x(X) or y(Y) */ F_N, /* a ATOM / INTEGER */ MP_N, /* a [ATOM :] ATOM / INTEGER (optional module qualif) */ LABEL, /* a label */ ANY, /* ATOM or INTEGER or F_N or FLOAT or X_Y */ LIST_INST /* a list of instructions */ } ArgTyp; #define L1(t) L2(t, 0) #define L2(t1, t2) ((t1 << 16) | (t2)) #define DECODE_L2(a, t1, t2) t1 = (a) >> 16; t2 = (a) & ((1 << 16) - 1) typedef double ArgVal; /* to ensure double alignment */ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Parse_Wam_File(char *file_name_in, int comment); void Syntax_Error(char *s); #define Add_Arg(ptr, type, val) (*((type *) (ptr)) = (val) , (ptr)++) #define Get_Arg(ptr, type, val) ((val) = *((type *) (ptr)) , (ptr)++) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000021�13021324543�015153� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile wam2ma ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/bt_string.c����������������������������������������������������������������0000644�0001750�0001750�00000014223�13021324543�015333� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : WAM to mini-assembler translator * * File : bt_string.c * * Descr.: string dico management (file included by wam2ma.c and ma2asm.c) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "bt_string.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void BT_String_List_Rec(BTNode *bt_node, BTStrLstFct fct); /*-------------------------------------------------------------------------* * BT_STRING_INIT * * * *-------------------------------------------------------------------------*/ void BT_String_Init(BTString *bt_str) { bt_str->tree = NULL; bt_str->nb_elem = 0; } /*-------------------------------------------------------------------------* * BT_STRING_ADD * * * *-------------------------------------------------------------------------*/ BTNode * BT_String_Add(BTString *bt_str, char *str) { BTNode **pbt_node = &bt_str->tree; BTNode *bt_node; int cmp; while(*pbt_node) { bt_node = *pbt_node; cmp = strcmp(str, bt_node->str); if (cmp == 0) return bt_node; pbt_node = (cmp < 0) ? &(bt_node->left) : &(bt_node->right); } if ((bt_node = (BTNode *) malloc(sizeof(BTNode))) == NULL) { fprintf(stderr, "Cannot allocate memory for BT string: %s\n", str); exit(1); } bt_node->str = str; bt_node->no = (bt_str->nb_elem)++; memset(bt_node->info, 0, sizeof(bt_node)->info); bt_node->left = bt_node->right = NULL; *pbt_node = bt_node; return bt_node; } /*-------------------------------------------------------------------------* * BT_STRING_LOOKUP * * * *-------------------------------------------------------------------------*/ BTNode * BT_String_Lookup(BTString *bt_str, char *str) { BTNode *bt_node = bt_str->tree; int cmp; while(bt_node) { cmp = strcmp(str, bt_node->str); if (cmp == 0) return bt_node; bt_node = (cmp < 0) ? bt_node->left : bt_node->right; } return NULL; } /*-------------------------------------------------------------------------* * BT_STRING_LIST * * * *-------------------------------------------------------------------------*/ void BT_String_List(BTString *bt_str, BTStrLstFct fct) { BT_String_List_Rec(bt_str->tree, fct); } /*-------------------------------------------------------------------------* * BT_STRING_LIST_REC * * * *-------------------------------------------------------------------------*/ void BT_String_List_Rec(BTNode *bt_node, BTStrLstFct fct) { if (bt_node == NULL) return; BT_String_List_Rec(bt_node->left, fct); (*fct) (bt_node->no, bt_node->str, (void *) bt_node->info); BT_String_List_Rec(bt_node->right, fct); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/wam_protos.h���������������������������������������������������������������0000644�0001750�0001750�00000012234�13021324543�015537� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : WAM to mini-assembler translator * * File : wam_protos.h * * Descr.: code generation - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Source_Line(int line_no, char *cmt); void F_file_name(ArgVal arg[]); void F_predicate(ArgVal arg[]); void F_directive(ArgVal arg[]); void F_ensure_linked(ArgVal arg[]); void F_get_variable(ArgVal arg[]); void F_get_value(ArgVal arg[]); void F_get_atom(ArgVal arg[]); void F_get_integer(ArgVal arg[]); void F_get_float(ArgVal arg[]); void F_get_nil(ArgVal arg[]); void F_get_list(ArgVal arg[]); void F_get_structure(ArgVal arg[]); void F_put_variable(ArgVal arg[]); void F_put_void(ArgVal arg[]); void F_put_value(ArgVal arg[]); void F_put_unsafe_value(ArgVal arg[]); void F_put_atom(ArgVal arg[]); void F_put_integer(ArgVal arg[]); void F_put_float(ArgVal arg[]); void F_put_nil(ArgVal arg[]); void F_put_list(ArgVal arg[]); void F_put_structure(ArgVal arg[]); void F_put_meta_term(ArgVal arg[]); void F_math_load_value(ArgVal arg[]); void F_math_fast_load_value(ArgVal arg[]); void F_unify_variable(ArgVal arg[]); void F_unify_void(ArgVal arg[]); void F_unify_value(ArgVal arg[]); void F_unify_local_value(ArgVal arg[]); void F_unify_atom(ArgVal arg[]); void F_unify_integer(ArgVal arg[]); void F_unify_nil(ArgVal arg[]); void F_unify_list(ArgVal arg[]); void F_unify_structure(ArgVal arg[]); void F_allocate(ArgVal arg[]); void F_deallocate(ArgVal arg[]); void F_call(ArgVal arg[]); void F_execute(ArgVal arg[]); void F_proceed(ArgVal arg[]); void F_fail(ArgVal arg[]); void F_label(ArgVal arg[]); void F_switch_on_term(ArgVal arg[]); void F_switch_on_atom(ArgVal arg[]); void F_switch_on_integer(ArgVal arg[]); void F_switch_on_structure(ArgVal arg[]); void F_try_me_else(ArgVal arg[]); void F_retry_me_else(ArgVal arg[]); void F_trust_me_else_fail(ArgVal arg[]); void F_try(ArgVal arg[]); void F_retry(ArgVal arg[]); void F_trust(ArgVal arg[]); void F_pragma_arity(ArgVal arg[]); void F_get_current_choice(ArgVal arg[]); void F_cut(ArgVal arg[]); void F_soft_cut(ArgVal arg[]); void F_function(ArgVal arg[]); void F_call_c(ArgVal arg[]); void F_foreign_call_c(ArgVal arg[]); ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Wam2Ma/Makefile.in����������������������������������������������������������������0000644�0001750�0001750�00000001025�13021324543�015235� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ all: wam2ma@EXE_SUFFIX@ wam_parser@OBJ_SUFFIX@: wam_parser.c wam_parser.h wam_protos.h $(CC) $(CFLAGS) -c wam_parser.c wam2ma@OBJ_SUFFIX@: wam2ma.c wam_parser.h bt_string.c ../TopComp/copying.c $(CC) $(CFLAGS) -c wam2ma.c wam2ma@EXE_SUFFIX@: wam2ma@OBJ_SUFFIX@ wam_parser@OBJ_SUFFIX@ $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@wam2ma@EXE_SUFFIX@ wam2ma@OBJ_SUFFIX@ wam_parser@OBJ_SUFFIX@ clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp wam2ma@EXE_SUFFIX@ distclean: clean �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/��������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013502� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/linedit.c�����������������������������������������������������������������0000644�0001750�0001750�00000115105�13021324543�015275� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : linedit.c * * Descr.: line editor * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <ctype.h> #include <string.h> #include <signal.h> #include <sys/types.h> #include <sys/stat.h> #include "../EnginePl/gp_config.h" #define LE_DEFINE_HOOK_MACROS #include "terminal.h" #include "ctrl_c.h" #include "linedit.h" #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #include <sys/time.h> #elif defined(_WIN32) #include <time.h> #endif #if 1 #define TREAT_BUFFERED_CHARS /* treat buffered chars at start (X paste) */ #endif #if 1 #define NO_DUP_IN_HISTORY /* do not put in history line == the last */ #endif #if 1 #define IGNORE_QUOTED_PART /* ingore quoted item in bracket matching */ #endif #if 0 #define NO_USE_SELECT /* no use select(2) for temporisation */ #endif /*---------------------------------* * Constants * *---------------------------------*/ #define LINEDIT_VERSION "2.5" #define MAX_HISTORY_LINES 64 #define MAX_SEPARATORS 256 #define NB_TAB_BEFORE_LIST 1 #define DEFAULT_SEPARATORS " ,;:-'\"!@$#^&()-+*/\\[]|<=>`~{}" #define NB_MATCH_LINES_BEFORE_ASK 20 #define OPEN_BRACKET "([{" #define CLOSE_BRACKET ")]}" #ifdef NO_USE_SELECT #define BRACKET_TIMMING 300000 /* in microseconds */ #else #define BRACKET_TIMMING 900000 /* in microseconds */ #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int buff_length; int line_length; char *line; } HistCell; typedef struct comp_node CompNode; struct comp_node { char *word; int word_length; CompNode *next; }; /*---------------------------------* * Global Variables * *---------------------------------*/ static char separators[MAX_SEPARATORS] = DEFAULT_SEPARATORS; static int ins_mode = 1; static char *global_str; static char *global_pos; static char *global_end; static int prompt_length; static PlLong ctrl_c_ret_val; static char clipboard[4096] = ""; static HistCell hist_tbl[MAX_HISTORY_LINES]; static int hist_start = 0; static int hist_end = 0; static CompNode *comp_start = NULL; static CompNode *comp_first_match; static CompNode *comp_last_match; static int comp_nb_match; static int comp_match_max_lg; static CompNode *comp_cur_match; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int New_Char(int c, char *str, int size, char **p_pos, char **p_end); static char *Skip(char *from, char *limit, int res_sep_cmp, int direction); static int Is_A_Separator(char c); static int Search_Bracket(char *brackets, char c); static int Tab_To_Spaces(int p); static void History_Add_Line(char *line, int length); static void History_Update_Line(char *line, int length, int hist_no); static int History_Get_Line(char *str, int hist_no); static char *Completion_Do_Match(char *prefix, int prefix_length, int *rest_length); static void Completion_Print_All(void); static void Display_Help(void); #define NewLn() { PUT_CHAR('\n'); } #define Hist_Inc(n) { if (++(n) >= MAX_HISTORY_LINES) (n) = 0; } #define Hist_Dec(n) { if (--(n) < 0) (n) = MAX_HISTORY_LINES - 1; } #define Hist_First(n) { (n) = Hist_Start_Entry(); } #define Hist_Last(n) { (n) = Hist_End_Entry(); } #define Hist_Start_Entry() (hist_start) #define Hist_End_Entry() (hist_end) #define Hist_Is_Empty() (hist_start == hist_end) #define RE_DISPLAY_LINE \ do { \ if (prompt && display_prompt) \ DISPL_STR(prompt); \ \ DISPL(end - str, str); \ BACKD(end - pos); \ } while(0) /*-------------------------------------------------------------------------* * PL_LE_GETS * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Gets(char *str) { int l; int big_size = ((unsigned) -1) >> 1; if ((str = Pl_LE_FGets(str, big_size, NULL, 0)) != NULL) { l = strlen(str) - 1; /* for gets remove last \n */ if (l >= 0 && str[l] == '\n') str[l] = '\0'; } return str; } /*-------------------------------------------------------------------------* * PL_LE_FGETS * * * *-------------------------------------------------------------------------*/ char * Pl_LE_FGets(char *str, int size, char *prompt, int display_prompt) { char *pos = str; char *end = str; char *mark = NULL; char *p, *q, *start, *stop; char w; int c, n, n1; int last_was_eof = 0; int h_no = Hist_End_Entry(); int rest_length; int tab_count = 0; int count_bracket[3]; Pl_LE_Initialize(); size--; /* -1 for '\0' */ prompt_length = (prompt && display_prompt) ? strlen(prompt) : 0; Pl_LE_Open_Terminal(); global_str = str; #ifdef TREAT_BUFFERED_CHARS /* treat buffered lines (for paste) */ while (KBD_IS_NOT_EMPTY) { if (end - str >= size || ((c = Pl_LE_Get_Char()) == '\n') || c == '\r') { RE_DISPLAY_LINE; goto return_is_read; } if (c == '\t') /* '\t' on output would cause trouble */ for(n = Tab_To_Spaces(end - str); n; n--) *end++ = ' '; else *end++ = c; } if (end != str) { pos = end; goto re_display_line; } #endif if (prompt && display_prompt) DISPL_STR(prompt); for (;;) { global_pos = pos; global_end = end; c = Pl_LE_Get_Char(); one_char: *end = ' '; /* to allow for separator test */ if (Pl_LE_Is_Interrupt_Key(c)) { /* save global vars for reentrancy */ int save_prompt_length = prompt_length; FORWD(end - pos, pos); /* go to EOL to avoid multi-line */ /* truncation on the output */ Pl_LE_Close_Terminal(); c = *end; *end = '\0'; /* to allow the handler to use/test str */ if ((ctrl_c_ret_val = Pl_Emit_Ctrl_C()) != 0) return (char *) -2; Pl_LE_Open_Terminal(); *end = c; global_str = str; /* restore global vars for reentrancy */ prompt_length = save_prompt_length; re_display_line: /* display prompt + full line */ RE_DISPLAY_LINE; continue; } if (KEY_IS_EOF(c)) /* to avoid EOF when typing too much ^D */ { if (end == str) { if (c == KEY_CTRL('D') && last_was_eof) goto error; else { str = NULL; goto finish; } } last_was_eof = (c == KEY_CTRL('D')); } else last_was_eof = 0; if (c != '\t') tab_count = 0; switch (c) { case KEY_CTRL('A'): /* go to begin of line */ case KEY_EXT_HOME: BACKD(pos - str); pos = str; continue; case KEY_CTRL('E'): /* go to end of line */ case KEY_EXT_END: FORWD(end - pos, pos); pos = end; continue; case KEY_CTRL('B'): /* go to 1 char backward */ case KEY_EXT_LEFT: if (pos == str) goto error; BACKD(1); pos--; continue; case KEY_CTRL('F'): /* go to 1 char forward */ case KEY_EXT_RIGHT: if (pos == end) goto error; FORWD(1, pos); pos++; continue; case KEY_BACKSPACE: /* erase previous char */ case KEY_DELETE: if (pos == str) goto error; del_last: for (p = pos; p < end; p++) p[-1] = *p; BACKD(1); pos--; end--; DISPL(end - pos, pos); ERASE(1); BACKD(end - pos); continue; case KEY_CTRL('D'): /* erase current char */ case KEY_EXT_DELETE: if (pos == end) goto error; /* simply equivalent to ^F + BACKSPACE */ FORWD(1, pos); pos++; goto del_last; case KEY_CTRL('U'): /* erase begin of line */ case KEY_ID2(KEY_MODIF_CTRL, KEY_EXT_HOME): q = clipboard; p = str; while (p < pos) /* add deleted part to clipboard */ *q++ = *p++; *q = '\0'; n = pos - str; for (p = pos; p < end; p++) p[-n] = *p; pos = str; end -= n; BACKD(n); DISPL(end - pos, pos); ERASE(n); BACKD(end - pos); continue; case KEY_CTRL('K'): /* erase end of line */ case KEY_ID2(KEY_MODIF_CTRL, KEY_EXT_END): q = clipboard; p = pos; while (p < end) /* add deleted part to clipboard */ *q++ = *p++; *q = '\0'; ERASE(end - pos); end = pos; continue; case KEY_CTRL('Y'): /* paste from clipboard */ for (p = clipboard; *p; p++) if (!New_Char(*p, str, size, &pos, &end)) goto error; continue; case KEY_CTRL(' '): /* mark begin selection */ mark = pos; continue; case KEY_ESC('W'): /* copy (from mark) to clipboard */ case KEY_CTRL('W'): /* cut (from mark) to clipboard */ if (mark == NULL) goto error; if (mark < pos) { start = mark; stop = pos; } else { start = pos; stop = mark; } q = clipboard; p = start; while (p < stop) *q++ = *p++; *q = '\0'; if (c == KEY_ESC('W')) continue; n = stop - start; for (p = stop; p < end; p++) p[-n] = *p; if (mark < pos) BACKD(n); pos = start; end -= n; DISPL(end - pos, pos); ERASE(n); BACKD(end - pos); continue; case KEY_ESC('B'): /* go to previous word */ case KEY_ID2(KEY_MODIF_CTRL, KEY_EXT_LEFT): p = (pos == str) ? pos : pos - 1; /* to avoid start of a word */ p = Skip(p, str, 1, -1); /* skip separators */ p = Skip(p, str, 0, -1); /* skip non separators */ p = Skip(p, end, 1, +1); /* skip separators */ BACKD(pos - p); pos = p; continue; case KEY_ESC('F'): /* go to next word */ case KEY_ID2(KEY_MODIF_CTRL, KEY_EXT_RIGHT): p = pos; p = Skip(p, end, 0, +1); /* skip non separators */ p = Skip(p, end, 1, +1); /* skip separators */ FORWD(p - pos, pos); pos = p; continue; case KEY_ESC('C'): /* capitalize word */ p = pos; p = Skip(p, end, 1, +1); /* skip separators */ if (islower(*p)) *p = *p - 'a' + 'A'; p = Skip(p, end, 0, +1); /* skip non separators */ DISPL(p - pos, pos); pos = p; continue; case KEY_ESC('L'): /* convert to lower case */ p = pos; p = Skip(p, end, 1, +1); /* skip separators */ for (; p < end && !Is_A_Separator(*p); p++) *p = tolower(*p); DISPL(p - pos, pos); pos = p; continue; case KEY_ESC('U'): /* convert to upper case */ p = pos; p = Skip(p, end, 1, +1); /* skip separators */ for (; p < end && !Is_A_Separator(*p); p++) *p = toupper(*p); DISPL(p - pos, pos); pos = p; continue; case '\t': /* TAB: completion */ if (tab_count != 0) /* already a TAB */ { if (++tab_count > NB_TAB_BEFORE_LIST) { NewLn(); Completion_Print_All(); goto re_display_line; } goto error; } p = (pos == str) ? pos : pos - 1; /* to avoid start of a word */ p = Skip(p, str, 0, -1); /* skip non separators */ p = Skip(p, end, 1, +1); /* skip separators */ w = *pos; /* prefix from p to pos */ *pos = '\0'; p = Completion_Do_Match(p, pos - p, &rest_length); *pos = w; if (p == NULL) goto error; while (rest_length--) if (!New_Char(*p++, str, size, &pos, &end)) goto error; if (comp_first_match != comp_last_match) { tab_count = 1; goto error; /* for the beep */ } tab_count = 0; continue; case KEY_ESC('\t'): /* transform a tab to spaces */ for (n = Tab_To_Spaces(pos - str); n; n--) if (!New_Char(' ', str, size, &pos, &end)) goto error; continue; case KEY_CTRL('V'): /* switch insert mode (on/off) */ case KEY_EXT_INSERT: ins_mode = 1 - ins_mode; INS_MODE(ins_mode); continue; case KEY_CTRL('T'): /* swap last and current char */ if (pos == str || pos == end) goto error; w = pos[0]; pos[0] = pos[-1]; pos[-1] = w; BACKD(1); DISPL(2, pos - 1); pos++; continue; case '\n': case '\r': return_is_read: FORWD(end - pos, pos); /* go to EOL to avoid multi-line */ /* truncation on the output */ *end = '\0'; History_Add_Line(str, end - str); if (end - str < size) /* '\n' can be added */ *end++ = '\n'; *end = '\0'; goto finish; case KEY_CTRL('P'): /* history: recall previous line */ case KEY_EXT_UP: if (Hist_Is_Empty() || h_no == Hist_Start_Entry()) goto error; *end = '\0'; History_Update_Line(str, end - str, h_no); Hist_Dec(h_no); write_hist_line: p = end; end = str + History_Get_Line(str, h_no); BACKD(pos - str); DISPL(end - str, str); if (end < p) ERASE(p - end); pos = end; continue; case KEY_CTRL('N'): /* history: recall next line */ case KEY_EXT_DOWN: if (Hist_Is_Empty() || h_no == Hist_End_Entry()) goto error; *end = '\0'; History_Update_Line(str, end - str, h_no); Hist_Inc(h_no); goto write_hist_line; case KEY_ESC('P'): /* history: recall previous matching line */ if (Hist_Is_Empty() || pos == str) goto error; *end = '\0'; History_Update_Line(str, end - str, h_no); try_previous: if (h_no == Hist_Start_Entry()) goto error; Hist_Dec(h_no); if (hist_tbl[h_no].line == NULL || strncmp(str, hist_tbl[h_no].line, pos - str) != 0) goto try_previous; write_hist_match_line: p = end; end = str + History_Get_Line(str, h_no); DISPL(end - pos, pos); if (end < p) ERASE(p - end); BACKD(end - pos); continue; case KEY_ESC('N'): /* history: recall next matching line */ if (Hist_Is_Empty() || pos == str) goto error; *end = '\0'; History_Update_Line(str, end - str, h_no); try_next: if (Hist_Is_Empty() || h_no == Hist_End_Entry()) goto error; Hist_Inc(h_no); if (hist_tbl[h_no].line == NULL || strncmp(str, hist_tbl[h_no].line, pos - str) != 0) goto try_next; goto write_hist_match_line; case KEY_ESC('<'): /* history: recall first line */ case KEY_EXT_PAGE_UP: if (Hist_Is_Empty() || h_no == Hist_Start_Entry()) goto error; *end = '\0'; History_Update_Line(str, end - str, h_no); Hist_First(h_no); goto write_hist_line; case KEY_ESC('>'): /* history: recall last line */ case KEY_EXT_PAGE_DOWN: if (Hist_Is_Empty() || h_no == Hist_End_Entry()) goto error; *end = '\0'; History_Update_Line(str, end - str, h_no); Hist_Last(h_no); goto write_hist_line; case KEY_ESC('?'): /* display help */ display_help: NewLn(); Display_Help(); goto re_display_line; default: if ((unsigned) c > 255 || !isprint(c)) { n = c; EMIT_BEEP; c = Pl_LE_Get_Char(); if (c != n) goto one_char; goto display_help; } if (!New_Char(c, str, size, &pos, &end)) goto error; /* brackets ([{ }]): matching */ if (KBD_IS_NOT_EMPTY || (n = Search_Bracket(CLOSE_BRACKET, c)) < 0) continue; count_bracket[0] = count_bracket[1] = count_bracket[2] = 0; count_bracket[n]--; p = pos - 1; for (; count_bracket[n] != 0;) { if (--p < str) goto bracket_exit; c = *p; if ((n1 = Search_Bracket(CLOSE_BRACKET, c)) >= 0) { count_bracket[n1]--; continue; } if ((n1 = Search_Bracket(OPEN_BRACKET, c)) >= 0) if (++count_bracket[n1] > 0) goto bracket_exit; #ifdef IGNORE_QUOTED_PART if (p > str && (c == '\'' || c == '"') && p[-1] != '\\') { /* ignore quoted part */ while (--p > str && (*p != c || p[-1] == '\\')) ; } #endif } if (KBD_IS_NOT_EMPTY) continue; n = pos - p; q = pos; BACKD(n); #if defined(_WIN32) && !defined(__CYGWIN__) { PlLong t0 = clock(), t1; do t1 = clock(); while (!KBD_IS_NOT_EMPTY && (t1 - t0) * 1000000 / CLOCKS_PER_SEC < BRACKET_TIMMING); } #elif !defined(NO_USE_SELECT) { fd_set set; struct timeval t; t.tv_sec = 0; t.tv_usec = BRACKET_TIMMING; FD_ZERO(&set); FD_SET(0, &set); select(1, &set, NULL, NULL, &t); } #else usleep(BRACKET_TIMMING); #endif pos = p; FORWD(n, pos); pos = q; bracket_exit: continue; } error: EMIT_BEEP; } finish: NewLn(); Pl_LE_Close_Terminal(); return str; } /*-------------------------------------------------------------------------* * NEW_CHAR * * * *-------------------------------------------------------------------------*/ static int New_Char(int c, char *str, int size, char **p_pos, char **p_end) { char *pos = *p_pos; char *end = *p_end; char *p; if ((ins_mode || pos == end) && end - str >= size) return 0; if (!ins_mode) { *pos = (char) c; if (++pos > end) end = pos; PUT_CHAR(c); } else { for (p = end; p > pos; p--) *p = p[-1]; *pos = (char) c; end++; DISPL(end - pos, pos); pos++; BACKD(end - pos); } *p_pos = pos; *p_end = end; return 1; } /*-------------------------------------------------------------------------* * PL_LE_GET_PROMPT_LENGTH * * * *-------------------------------------------------------------------------*/ int Pl_LE_Get_Prompt_Length(void) { return prompt_length; } /*-------------------------------------------------------------------------* * PL_LE_GET_CURRENT_POSITION * * * *-------------------------------------------------------------------------*/ int Pl_LE_Get_Current_Position(void) { return global_pos - global_str; } /*-------------------------------------------------------------------------* * PL_LE_GET_CURRENT_WORD * * * *-------------------------------------------------------------------------*/ void Pl_LE_Get_Current_Word(char *word) { char *str = global_str; char *pos = global_pos; char *end = global_end; char *p, *q; p = Skip(pos, str, 0, -1); /* skip non separators */ if (Is_A_Separator(*p)) p++; q = Skip(pos, end, 0, +1); /* skip non separators */ while (p < q) *word++ = *p++; *word = '\0'; } /*-------------------------------------------------------------------------* * PL_LE_GET_SEPARATORS * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Get_Separators(void) { return separators; } /*-------------------------------------------------------------------------* * PL_LE_SET_SEPARATORS * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Set_Separators(char *sep_str) { return strcpy(separators, sep_str); } /*-------------------------------------------------------------------------* * PL_LE_GET_CTRL_C_RETURN_VALUE * * * *-------------------------------------------------------------------------*/ PlLong Pl_LE_Get_Ctrl_C_Return_Value(void) { return ctrl_c_ret_val; } /*-------------------------------------------------------------------------* * SKIP * * * *-------------------------------------------------------------------------*/ static char * Skip(char *from, char *limit, int res_sep_cmp, int direction) { while (from != limit) { if (Is_A_Separator(*from) != res_sep_cmp) break; /* exit since *from does not satisfy res_sep_cmp */ from = from + direction; } return from; } /*-------------------------------------------------------------------------* * IS_A_SEPARATOR * * * *-------------------------------------------------------------------------*/ static int Is_A_Separator(char c) { char *p; /* like strchr(separators,c) but does not take into account '\0' */ for (p = separators; *p; p++) if (*p == c) return 1; return 0; } /*-------------------------------------------------------------------------* * SEARCH_BRACKET * * * *-------------------------------------------------------------------------*/ static int Search_Bracket(char *brackets, char c) { int n; for(n = 0; brackets[n] != '\0'; n++) if (brackets[n] == c) return n; return -1; } /*-------------------------------------------------------------------------* * TAB_TO_SPACES * * * *-------------------------------------------------------------------------*/ static int Tab_To_Spaces(int p) { p += prompt_length; p = 8 - (p % 8); return p; } /*-------------------------------------------------------------------------* * HISTORY_ADD_LINE * * * *-------------------------------------------------------------------------*/ static void History_Add_Line(char *line, int length) { char *p = line; while (*p == ' ') p++; if (*p == '\0') /* do not add an empty line */ return; #ifdef NO_DUP_IN_HISTORY if (hist_end > 0 && strcmp(line, hist_tbl[hist_end - 1].line) == 0) return; #endif History_Update_Line(line, length, hist_end); Hist_Inc(hist_end); if (hist_end == hist_start) Hist_Inc(hist_start); } /*-------------------------------------------------------------------------* * HISTORY_UPDATE_LINE * * * *-------------------------------------------------------------------------*/ static void History_Update_Line(char *line, int length, int hist_no) { HistCell *h; h = hist_tbl + hist_no; if (h->line != NULL && h->buff_length < length) { free(h->line); h->line = NULL; /* to ensure future malloc */ } if (h->line == NULL) /* not yet allocated */ { if ((h->line = (char *) malloc(length + 1)) == NULL) exit(1); h->buff_length = length; } strcpy(h->line, line); h->line_length = length; } /*-------------------------------------------------------------------------* * HISTORY_GET_LINE * * * *-------------------------------------------------------------------------*/ static int History_Get_Line(char *str, int hist_no) { HistCell *h = hist_tbl + hist_no; strcpy(str, h->line); return h->line_length; } /*-------------------------------------------------------------------------* * PL_LE_COMPL_ADD_WORD * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Compl_Add_Word(char *word, int word_length) { CompNode **p; CompNode *q; int cmp; for (p = &comp_start; *p; p = &(*p)->next) { cmp = strcmp((*p)->word, word); if (cmp == 0) return word; if (cmp > 0) break; } if ((q = (CompNode *) malloc(sizeof(CompNode))) == NULL) exit(1); q->word = word; q->word_length = word_length; q->next = *p; *p = q; return word; } /*-------------------------------------------------------------------------* * PL_LE_COMPL_DEL_WORD * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Compl_Del_Word(char *word) { CompNode **p; CompNode *q; int cmp; for (p = &comp_start; *p; p = &(*p)->next) { cmp = strcmp((*p)->word, word); if (cmp == 0) break; if (cmp > 0) return NULL; } q = *p; *p = q->next; free(q); return word; } /*-------------------------------------------------------------------------* * PL_LE_COMPL_INIT_MATCH * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Compl_Init_Match(char *prefix, int *nb_match, int *max_lg) { int prefix_length, rest_length; char *str; prefix_length = strlen(prefix); if (Completion_Do_Match(prefix, prefix_length, &rest_length) == NULL) return NULL; if ((str = (char *) malloc(prefix_length + rest_length + 1)) == NULL) exit(1); *nb_match = comp_nb_match; *max_lg = comp_match_max_lg; comp_cur_match = comp_first_match; strncpy(str, comp_first_match->word, prefix_length + rest_length); str[prefix_length + rest_length] = '\0'; return str; } /*-------------------------------------------------------------------------* * PL_LE_COMPL_FIND_MATCH * * * *-------------------------------------------------------------------------*/ char * Pl_LE_Compl_Find_Match(int *is_last) { char *str; if (comp_cur_match == NULL) return NULL; str = comp_cur_match->word; if (comp_cur_match != comp_last_match) { comp_cur_match = comp_cur_match->next; *is_last = 0; } else { comp_cur_match = NULL; *is_last = 1; } return str; } /*-------------------------------------------------------------------------* * COMPLETION_DO_MATCH * * * *-------------------------------------------------------------------------*/ static char * Completion_Do_Match(char *prefix, int prefix_length, int *rest_length) { CompNode *p; int cmp; int l; char w; comp_first_match = NULL; comp_nb_match = 0; comp_match_max_lg = 0; for (p = comp_start; p; p = p->next) { cmp = strncmp(p->word, prefix, prefix_length); if (cmp == 0) { if (comp_first_match == NULL) comp_first_match = p; comp_last_match = p; comp_nb_match++; if (p->word_length > comp_match_max_lg) comp_match_max_lg = p->word_length; } else if (cmp > 0) break; } if (comp_first_match == NULL) return NULL; if (comp_first_match == comp_last_match) *rest_length = comp_first_match->word_length - prefix_length; else { /* determine longest common suffix */ l = prefix_length; for (;;) { w = comp_first_match->word[l]; p = comp_first_match->next; for (;;) { if (p->word[l] != w) /* also deals with '\0' */ goto diff_found; if (p == comp_last_match) break; p = p->next; } l++; } diff_found: *rest_length = l - prefix_length; } return comp_first_match->word + prefix_length; } /*-------------------------------------------------------------------------* * COMPLETION_PRINT_ALL * * * *-------------------------------------------------------------------------*/ static void Completion_Print_All(void) { CompNode *p, *p1; int row, col; int nb_in_a_line, nb_lines; int nb_in_last_line, nb_miss_in_last_line; int spaces, skip; int k; char buff[512]; int l, c; SCREEN_SIZE(&row, &col); nb_in_a_line = col / (comp_match_max_lg + 2); /* at least 2 chars to separate */ if (nb_in_a_line <= 1) nb_in_a_line = 1; nb_lines = (comp_nb_match + nb_in_a_line - 1) / nb_in_a_line; nb_in_last_line = ((comp_nb_match - 1) % nb_in_a_line) + 1; nb_miss_in_last_line = nb_in_a_line - nb_in_last_line; spaces = (nb_in_a_line == 1) ? 0 : (col - nb_in_a_line * comp_match_max_lg) / nb_in_a_line; if (nb_lines > NB_MATCH_LINES_BEFORE_ASK) /* too many matchings ? */ { sprintf(buff, "Show all %d possibilities (y/n) ? ", comp_nb_match); DISPL_STR(buff); c = Pl_LE_Get_Char(); NewLn(); if (c != 'y') return; } p = comp_first_match; l = 0; for (;;) { p1 = p; c = 0; for (;;) { DISPL_STR(p1->word); if (++c == ((l < nb_lines - 1) ? nb_in_a_line : nb_in_last_line)) break; sprintf(buff, "%*s", comp_match_max_lg - p1->word_length + spaces, ""); DISPL_STR(buff); skip = nb_lines; if (c > nb_in_a_line - nb_miss_in_last_line) skip--; for (k = 0; k < skip; k++) p1 = p1->next; } NewLn(); if (++l == nb_lines) break; p = p->next; } } /*-------------------------------------------------------------------------* * DISPLAY_HELP * * * *-------------------------------------------------------------------------*/ static void Display_Help(void) #define L(msg) DISPL_STR(msg); NewLn() { char buff[80]; L(""); sprintf(buff, " linedit %-25s Copyright (C) 1999-2015 Daniel Diaz", LINEDIT_VERSION); L(buff); L(""); L(" Moving"); L(" Ctl-B previous char Ctl-F next char"); L(" Esc-B previous word Esc-F next word"); L(" Ctl-A begin of line Ctl-E end of line"); L(""); L(" Deleting"); L(" Ctl-U delete begin of line Ctl-K delete end of line"); L(" Ctl-H delete previous char Ctl-D delete current char"); L(""); L(" Changing"); L(" Esc-L downcase word Esc-U upcase word"); L(" Esc-C capitalize word Ctl-T reverse last two chars"); L(""); L(" History"); L(" Esc-< first line Esc-> last line"); L(" Ctl-P previous line Ctl-N next line"); L(" Esc-P previous matching line Esc-N next matching line"); L(""); L(" Selection"); L(" Ctl-spc mark selection Ctl-W cut selection"); L(" Esc-W copy selection Ctl-Y past selection"); L(""); L(" Miscellaneous"); L(" Ctl-V insert mode switch Ctl-I completion (twice = all)"); L(" Esc-? display this help Esc-Ctl-I insert spaces for tab"); L(""); } #undef L /*-------------------------------------------------------------------------* * PL_LE_GET_KEY * * * *-------------------------------------------------------------------------*/ int Pl_LE_Get_Key(int echo, int catch_ctrl_c) { int c; Pl_LE_Initialize(); prompt_length = 0; start: Pl_LE_Open_Terminal(); c = Pl_LE_Get_Char(); if (catch_ctrl_c && Pl_LE_Is_Interrupt_Key(c)) { Pl_LE_Close_Terminal(); if ((ctrl_c_ret_val = Pl_Emit_Ctrl_C()) != 0) return -2; goto start; } if (KEY_IS_EOF(c)) c = EOF; if (echo && (unsigned) c <= 255 && isprint(c)) PUT_CHAR(c); Pl_LE_Close_Terminal(); return c; } /*-------------------------------------------------------------------------* * PL_LE_PRINTF * * * *-------------------------------------------------------------------------*/ int Pl_LE_Printf(char *format, ...) { va_list arg_ptr; static char buff[65535]; int ret; Pl_LE_Initialize(); va_start(arg_ptr, format); ret = vsprintf(buff, format, arg_ptr); DISPL_STR(buff); va_end(arg_ptr); return ret; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/README��������������������������������������������������������������������0000644�0001750�0001750�00000001306�13021324543�014356� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������The environment variable LINEDIT can be set to control the behavior of linedit. The value can contain as substring (no spaces are allowed around =): gui=no do not lauch the GUI console (Win32 specific) ansi=no do not use ANSI ESC sequences (to move cursor, ...) out=FD write output chars to the FD file descriptor (for echo, ...) out=FILE write output to the file FILE (for echo, ...) e.g. export LINEDIT='out=/dev/..., ansi=no' NB: to run test_linedit, the PATH should contain ../W32GUICons since the dll is there, (use ../SETVARS) VCTestLinedit contains a MSVC project to compile both test_linedit and the dll LccTestLinedit contains a LCC project to compile test_linedit under wedit ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/.gitignore����������������������������������������������������������������0000644�0001750�0001750�00000000124�13021324543�015463� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile VC_LINK VSTestLinedit LccTestLinedit lccmake makefile.lcc test_linedit ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/ctrl_c.c������������������������������������������������������������������0000644�0001750�0001750�00000014501�13021324543�015111� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : ctrl_c.c * * Descr.: Ctrl+C management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "../EnginePl/gp_config.h" #include <stdio.h> #include <signal.h> #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #endif #if defined(_WIN32) && !defined(__CYGWIN__) #define WIN32_CONSOLE_CTRL_HANDLER #endif #ifdef WIN32_CONSOLE_CTRL_HANDLER #include <windows.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static PlLong (*ctrl_c_handler) (); static int from_callback; static PlLong ret_val; static int inside_ctrl_c; #ifdef WIN32_CONSOLE_CTRL_HANDLER static HANDLE event_ctrl_handler_exited; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * WRAPPER_HANDLER * * * *-------------------------------------------------------------------------*/ #ifdef WIN32_CONSOLE_CTRL_HANDLER static BOOL WINAPI Wrapper_Handler(DWORD sig) #else static void Wrapper_Handler(int sig) #endif { #if defined(__unix__) || defined(__CYGWIN__) sigset_t set; #endif int from_callback1; #if defined(__unix__) || defined(__CYGWIN__) sigemptyset(&set); sigaddset(&set, sig); sigprocmask(SIG_UNBLOCK, &set, NULL); #elif !defined(WIN32_CONSOLE_CTRL_HANDLER) signal(sig, Wrapper_Handler); #endif if (inside_ctrl_c) { printf("Already in a Ctrl+C handler - ignored\n"); fflush(stdout); ret_val = 0; } else { inside_ctrl_c = from_callback; /* only 1 if from_callback */ from_callback1 = from_callback; from_callback = 0; ret_val = (*ctrl_c_handler) (from_callback1); } inside_ctrl_c = 0; #ifdef WIN32_CONSOLE_CTRL_HANDLER SetEvent(event_ctrl_handler_exited); return TRUE; #endif } /*-------------------------------------------------------------------------* * PL_EMIT_CTRL_C * * * *-------------------------------------------------------------------------*/ PlLong Pl_Emit_Ctrl_C(void) { from_callback = 1; #if 1 #if defined(__unix__) || defined(__CYGWIN__) kill(getpid(), SIGINT); #elif defined(_WIN32) && !defined(WIN32_CONSOLE_CTRL_HANDLER) raise(SIGINT); #elif defined(WIN32_CONSOLE_CTRL_HANDLER) if (!inside_ctrl_c) { GenerateConsoleCtrlEvent(CTRL_C_EVENT, 0); WaitForSingleObject(event_ctrl_handler_exited, INFINITE); } #else printf("don't know how to send a Ctrl+C\n"); #endif return ret_val; #else /* pb: CTRL+C under linedit does not generate a signal * i.e. problem under gdb to debug */ return (*ctrl_c_handler)(1); #endif } /*-------------------------------------------------------------------------* * PL_INSTALL_CTRL_C_HANDLER * * * *-------------------------------------------------------------------------*/ void Pl_Install_Ctrl_C_Handler(PlLong (*handler) (int)) { ctrl_c_handler = handler; #ifdef WIN32_CONSOLE_CTRL_HANDLER event_ctrl_handler_exited = CreateEvent(NULL, FALSE, FALSE, NULL); SetConsoleCtrlHandler(Wrapper_Handler, TRUE); #else signal(SIGINT, Wrapper_Handler); #endif } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/terminal.h����������������������������������������������������������������0000644�0001750�0001750�00000015055�13021324543�015470� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : stty.h * * Descr.: basic terminal operations - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define KEY_BACKSPACE '\b' #define KEY_DELETE 0x7f #define KEY_ID(code) KEY_ID2(KEY_MODIF_NONE, code) #define KEY_ID2(modif, code) (((modif) << 9) | ((1 << 8) | ((code) & 0x7f))) #define GET_MODIF(x) (((x) >> 9) & 7) #define GET_CODE(x) ((x) & 0x1ff) #define KEY_CTRL(x) ((x) & 0x1f) #define KEY_ESC(x) KEY_ID((1 << 7) | (x) | 0x20) /* 0x20 to be case insensitive */ #define IS_ESC_COMB(x) ((x) & (1 << 7)) #define GET_ESC_COMB(x) ((x) & 0x7f) #define KEY_MODIF_NONE 0 /* modifiers (additive) */ #define KEY_MODIF_SHIFT 1 #define KEY_MODIF_ALT 2 #define KEY_MODIF_CTRL 4 #if defined(__unix__) || defined(__CYGWIN__) /* Unix */ #define KEY_EXT_FCT_1 KEY_ID(11) #define KEY_EXT_FCT_2 KEY_ID(12) #define KEY_EXT_FCT_3 KEY_ID(13) #define KEY_EXT_FCT_4 KEY_ID(14) #define KEY_EXT_FCT_5 KEY_ID(15) #define KEY_EXT_FCT_6 KEY_ID(17) #define KEY_EXT_FCT_7 KEY_ID(18) #define KEY_EXT_FCT_8 KEY_ID(19) #define KEY_EXT_FCT_9 KEY_ID(20) #define KEY_EXT_FCT_10 KEY_ID(21) #define KEY_EXT_FCT_11 KEY_ID(23) #define KEY_EXT_FCT_12 KEY_ID(24) #define KEY_EXT_UP KEY_ID('A') #define KEY_EXT_DOWN KEY_ID('B') #define KEY_EXT_RIGHT KEY_ID('C') #define KEY_EXT_LEFT KEY_ID('D') #define KEY_EXT_HOME KEY_ID('H') #define KEY_EXT_END KEY_ID('F') #define KEY_EXT_PAGE_UP KEY_ID(5) #define KEY_EXT_PAGE_DOWN KEY_ID(6) #define KEY_EXT_INSERT KEY_ID(2) #define KEY_EXT_DELETE KEY_ID(3) #elif defined(_WIN32) /* Win32 */ #include <windows.h> #define KEY_EXT_FCT_1 KEY_ID(VK_F1) #define KEY_EXT_FCT_2 KEY_ID(VK_F2) #define KEY_EXT_FCT_3 KEY_ID(VK_F3) #define KEY_EXT_FCT_4 KEY_ID(VK_F4) #define KEY_EXT_FCT_5 KEY_ID(VK_F5) #define KEY_EXT_FCT_6 KEY_ID(VK_F6) #define KEY_EXT_FCT_7 KEY_ID(VK_F7) #define KEY_EXT_FCT_8 KEY_ID(VK_F8) #define KEY_EXT_FCT_9 KEY_ID(VK_F9) #define KEY_EXT_FCT_10 KEY_ID(VK_F10) #define KEY_EXT_FCT_11 KEY_ID(VK_F11) #define KEY_EXT_FCT_12 KEY_ID(VK_F12) #define KEY_EXT_UP KEY_ID(VK_UP) #define KEY_EXT_DOWN KEY_ID(VK_DOWN) #define KEY_EXT_RIGHT KEY_ID(VK_RIGHT) #define KEY_EXT_LEFT KEY_ID(VK_LEFT) #define KEY_EXT_HOME KEY_ID(VK_HOME) #define KEY_EXT_END KEY_ID(VK_END) #define KEY_EXT_PAGE_UP KEY_ID(VK_PRIOR) #define KEY_EXT_PAGE_DOWN KEY_ID(VK_NEXT) #define KEY_EXT_INSERT KEY_ID(VK_INSERT) #define KEY_EXT_DELETE KEY_ID(VK_DELETE) #endif #if defined(_WIN32) #define KEY_IS_EOF(c) ((c) == KEY_CTRL('D') || (c) == KEY_CTRL('Z')) #else #define KEY_IS_EOF(c) ((c) == KEY_CTRL('D')) #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_LE_Open_Terminal(void); void Pl_LE_Close_Terminal(void); void Pl_LE_Screen_Size(int *row, int *col); void Pl_LE_Ins_Mode(int ins_mode); int Pl_LE_Kbd_Is_Not_Empty(void); int Pl_LE_Is_Interrupt_Key(int c); void Pl_LE_Emit_Beep(void); void Pl_LE_Put_Char(int c); int Pl_LE_Get_Char(void); �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/test_noecho.c�������������������������������������������������������������0000644�0001750�0001750�00000014741�13021324543�016163� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : test_noecho.c * * Descr.: test file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <ctype.h> #include <stdarg.h> #define printf Pl_LE_Printf #include "../EnginePl/gp_config.h" #include "../EnginePl/set_locale.h" #include "../W32GUICons/w32gc_interf.h" /* only to test GUI Console memory size dialog box */ int pl_max_atom; /* to test the same dialog box */ #ifdef GUI_CONSOLE_WITH_STACK_SIZES #define ENGINE_FILE /* to define stacks data */ typedef PlLong WamWord; #include "../EnginePl/wam_stacks.h" #endif #include "terminal.h" #include "linedit.h" #ifdef _WIN32 #include <windows.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { int c; Set_Locale(); /* SetConsoleCP(1252); SetConsoleOutputCP(1252); */ while ((c = Pl_LE_Get_Key(0, 1)) != EOF) { printf("Read Char: %d (%#x)", c, c); if (c < 256) { if (c < 26) printf(" CTRL+%c", c - 1 + 'A'); if (isprint(c)) printf(" = %c", c); if (isalpha(c)) printf(" isalpha"); if (isascii(c)) printf(" isascii"); if (isupper(c)) printf(" isupper"); if (islower(c)) printf(" islower"); if (isspace(c)) printf(" isspace"); if (isprint(c)) printf(" isprint"); if (isgraph(c)) printf(" isgraph"); } else if (IS_ESC_COMB(c) && isalpha(GET_ESC_COMB(c))) printf(" ESC+%c", GET_ESC_COMB(c)); else { int modif = GET_MODIF(c); if (modif) { printf(" "); if (modif & KEY_MODIF_SHIFT) printf("SHIFT+"); if (modif & KEY_MODIF_ALT) printf("ALT+"); if (modif & KEY_MODIF_CTRL) printf("CTRL+"); } c = GET_CODE(c); if (!modif) printf(" "); switch(c) { case KEY_EXT_FCT_1: printf("F1 "); break; case KEY_EXT_FCT_2: printf("F2 "); break; case KEY_EXT_FCT_3: printf("F3 "); break; case KEY_EXT_FCT_4: printf("F4 "); break; case KEY_EXT_FCT_5: printf("F5 "); break; case KEY_EXT_FCT_6: printf("F6 "); break; case KEY_EXT_FCT_7: printf("F7 "); break; case KEY_EXT_FCT_8: printf("F8 "); break; case KEY_EXT_FCT_9: printf("F9 "); break; case KEY_EXT_FCT_10: printf("F10 "); break; case KEY_EXT_FCT_11: printf("F11 "); break; case KEY_EXT_FCT_12: printf("F12 "); break; case KEY_EXT_UP: printf("UP "); break; case KEY_EXT_DOWN: printf("DOWN "); break; case KEY_EXT_RIGHT: printf("RIGHT "); break; case KEY_EXT_LEFT: printf("LEFT "); break; case KEY_EXT_HOME: printf("HOME "); break; case KEY_EXT_END: printf("END "); break; case KEY_EXT_PAGE_UP: printf("PAGE_UP "); break; case KEY_EXT_PAGE_DOWN: printf("PAGE_DOWN"); break; case KEY_EXT_INSERT: printf("INSERT "); break; case KEY_EXT_DELETE: printf("DELETE "); break; } if (modif) printf(" modif=%d k=code=%d(%#x)", modif, c, c); } printf("\n"); } return 0; } �������������������������������gprolog-1.4.5/src/Linedit/terminal.c����������������������������������������������������������������0000644�0001750�0001750�00000055504�13021324543�015466� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : terminal.c * * Descr.: basic terminal operations * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <ctype.h> #include <fcntl.h> #include "../EnginePl/gp_config.h" #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #include <sys/ioctl.h> #include <sys/types.h> #include <sys/uio.h> #if defined(HAVE_SYS_IOCTL_COMPAT_H) #include <sys/ioctl_compat.h> #endif #if defined(HAVE_TERMIOS_H) #include <termios.h> typedef struct termios TermIO; #define Gtty(fd, s) tcgetattr(fd, s) #define Stty(fd, s) tcsetattr(fd, TCSANOW, s) #else #include <termio.h> typedef struct termio TermIO; #define Gtty(fd, s) ioctl(fd, TCGETA, s) #define Stty(fd, s) ioctl(fd, TCSETA, s) #endif /* !HAVE_TERMIOS_H */ #elif defined(_WIN32) #include <windows.h> #include <io.h> #include <conio.h> #endif #define LE_DEFINE_HOOK_MACROS #define TERMINAL_FILE #include "terminal.h" #include "linedit.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int use_linedit; static int use_gui; static int use_ansi; #if defined(__unix__) || defined(__CYGWIN__) static int fd_in = 0; /* not changed */ #endif static int fd_out = -1; #if defined(__unix__) || defined(__CYGWIN__) static int is_tty_in; static int is_tty_out; static TermIO old_stty_in; static TermIO new_stty_in; static TermIO old_stty_out; static TermIO new_stty_out; static int nb_rows, nb_cols; static int pos; #elif defined(_WIN32) static HANDLE h_stdin; static HANDLE h_stdout; static DWORD im; static int code_page = 0; static int oem_put = 1; static int oem_get = 1; #endif static int interrupt_key; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Parse_Env_Var(void); #if defined(__unix__) || defined(__CYGWIN__) static void Choose_Fd_Out(void); static void Set_TTY_Mode(TermIO *old, TermIO *new); #endif static int LE_Get_Char0(void); static void Backd(int n); static void Forwd(int n, char *str); static void Displ(int n, char *str); static void Displ_Str(char *s); static void Erase(int n); /*-------------------------------------------------------------------------* * PL_LE_INITIALIZE * * * *-------------------------------------------------------------------------*/ int Pl_LE_Initialize(void) { static int initialized = 0; static int le_mode; if (initialized) return le_mode; initialized = 1; Parse_Env_Var(); if (!use_linedit) return (le_mode = LE_MODE_DEACTIVATED); le_mode = LE_MODE_TTY; /* default */ #if defined(__unix__) || defined(__CYGWIN__) Choose_Fd_Out(); #endif if (pl_le_hook_start && use_gui) (*pl_le_hook_start) (use_gui == 2); if (pl_le_hook_put_char != NULL && pl_le_hook_get_char0 != NULL && pl_le_hook_kbd_is_not_empty != NULL && pl_le_hook_screen_size != NULL) le_mode = LE_MODE_HOOK; else { pl_le_hook_put_char = NULL; pl_le_hook_get_char0 = NULL; pl_le_hook_kbd_is_not_empty = NULL; pl_le_hook_screen_size = NULL; } #define INIT_FCT(hook, def) if (hook == NULL) hook = def /* inside terminal.c */ INIT_FCT(pl_le_hook_screen_size, Pl_LE_Screen_Size); INIT_FCT(pl_le_hook_kbd_is_not_empty, Pl_LE_Kbd_Is_Not_Empty); INIT_FCT(pl_le_hook_put_char, Pl_LE_Put_Char); INIT_FCT(pl_le_hook_get_char0, LE_Get_Char0); INIT_FCT(pl_le_hook_ins_mode, Pl_LE_Ins_Mode); INIT_FCT(pl_le_hook_emit_beep, Pl_LE_Emit_Beep); /* inside linedit.c */ INIT_FCT(pl_le_hook_backd, Backd); INIT_FCT(pl_le_hook_forwd, Forwd); INIT_FCT(pl_le_hook_displ, Displ); INIT_FCT(pl_le_hook_erase, Erase); INIT_FCT(pl_le_hook_displ_str, Displ_Str); #if defined(__unix__) || defined(__CYGWIN__) #elif defined(_WIN32) if (pl_le_hook_put_char == Pl_LE_Put_Char) /* DOS console mode */ { h_stdin = GetStdHandle(STD_INPUT_HANDLE); h_stdout = GetStdHandle(STD_OUTPUT_HANDLE); } interrupt_key = KEY_CTRL('C'); /* WIN32: interrupt = CTRL+C */ #endif return le_mode; } /*-------------------------------------------------------------------------* * PARSE_ENV_VAR * * * *-------------------------------------------------------------------------*/ static void Parse_Env_Var(void) { char *p; char buff[1024]; char *q; use_linedit = use_gui = use_ansi = 1; /* default */ p = getenv("LINEDIT"); if (p == NULL) return; if (strncmp(p, "no", 2) == 0) /* deactivate linedit */ { use_linedit = 0; return; } if (strstr(p, "gui=n") != NULL) use_gui = 0; if (strstr(p, "gui=s") != NULL) /* silent */ use_gui = 2; if (strstr(p, "ansi=n") != NULL) use_ansi = 0; #ifdef _WIN32 if ((q = strstr(p, "cp=")) != NULL && isdigit(q[3])) code_page = strtol(q + 3, NULL, 10), printf("cp read:%d\n", code_page); if (strstr(p, "oem_put=n") != NULL) oem_put = 0; if (strstr(p, "oem_put=y") != NULL) oem_put = 1; if (strstr(p, "oem_get=n") != NULL) oem_get = 0; if (strstr(p, "oem_get=y") != NULL) oem_get = 1; #endif if ((p = strstr(p, "out=")) != NULL) { p += 4; if (isdigit(*p)) fd_out = strtol(p, NULL, 10); else { q = buff; while(*p && isprint(*p) && !isspace(*p)) *q++ = *p++; *q = '\0'; fd_out = open(buff, O_WRONLY); /* on error fd_out = -1 */ } } return; } #if defined(__unix__) || defined(__CYGWIN__) /*-------------------------------------------------------------------------* * CHOOSE_FD_OUT * * * *-------------------------------------------------------------------------*/ static void Choose_Fd_Out(void) { int fd[3] = { 1, 0, 2 }; /* order fd list to try to find a tty */ int i, try; int mask; char *p; for(i = 0; i < 3 && fd_out < 0; i++) { try = fd[i]; if (!isatty(try)) continue; mask = fcntl(try, F_GETFL); if ((mask & O_WRONLY) == O_WRONLY || (mask & O_RDWR) == O_RDWR) { fd_out = try; break; } if ((p = ttyname(try)) != NULL) fd_out = open(p, O_WRONLY); } if (fd_out < 0) fd_out = 1; } #endif /*-------------------------------------------------------------------------* * PL_LE_OPEN_TERMINAL * * * *-------------------------------------------------------------------------*/ void Pl_LE_Open_Terminal(void) { fflush(stdout); fflush(stderr); #if defined(__unix__) || defined(__CYGWIN__) /* Mode cbreak (raw mode) */ is_tty_in = !Gtty(fd_in, &old_stty_in); is_tty_out = !Gtty(fd_out, &old_stty_out); if (is_tty_in) { interrupt_key = old_stty_in.c_cc[VINTR]; Set_TTY_Mode(&old_stty_in, &new_stty_in); Stty(fd_in, &new_stty_in); } else interrupt_key = KEY_CTRL('C'); if (is_tty_out) { Set_TTY_Mode(&old_stty_out, &new_stty_out); Stty(fd_out, &new_stty_out); } Pl_LE_Screen_Size(&nb_rows, &nb_cols); pos = 0; #elif defined(_WIN32) if (pl_le_hook_put_char == Pl_LE_Put_Char) /* DOS console mode */ { h_stdin = GetStdHandle(STD_INPUT_HANDLE); h_stdout = GetStdHandle(STD_OUTPUT_HANDLE); GetConsoleMode(h_stdin, &im); SetConsoleMode(h_stdin, im & ~ENABLE_PROCESSED_INPUT); if (code_page && (!SetConsoleCP(code_page) || !SetConsoleOutputCP(code_page))) printf("warning: Setting console code page to %d failed (error: %d)\n", code_page, (int) GetLastError()); } interrupt_key = KEY_CTRL('C'); /* WIN32: interrupt = CTRL+C */ #endif } /*-------------------------------------------------------------------------* * PL_LE_CLOSE_TERMINAL * * * *-------------------------------------------------------------------------*/ void Pl_LE_Close_Terminal(void) { #if defined(__unix__) || defined(__CYGWIN__) /* Initial mode (cooked mode) */ if (is_tty_in) Stty(fd_in, &old_stty_in); if (is_tty_out) Stty(fd_out, &old_stty_out); #elif defined(_WIN32) if (pl_le_hook_put_char == Pl_LE_Put_Char) /* DOS console mode */ SetConsoleMode(h_stdin, im); #endif } #if defined(__unix__) || defined(__CYGWIN__) /*-------------------------------------------------------------------------* * SET_TTY_MODE * * * * Mode cbreak (raw mode). * *-------------------------------------------------------------------------*/ static void Set_TTY_Mode(TermIO *old, TermIO *new) { *new = *old; new->c_iflag &= ~(INLCR | IGNCR | ICRNL | IXON | IXOFF); new->c_oflag = OPOST | ONLCR; new->c_lflag &= ~(ICANON | ECHO | ECHONL); new->c_cc[VMIN] = 1; /* MIN # of chars */ new->c_cc[VTIME] = 1; /* TIME */ new->c_cc[VINTR] = -1; /* deactivate SIGINT signal */ } #endif /*-------------------------------------------------------------------------* * PL_LE_SCREEN_SIZE * * * *-------------------------------------------------------------------------*/ void Pl_LE_Screen_Size(int *row, int *col) { #if defined(__unix__) || defined(__CYGWIN__) struct winsize ws; if (!is_tty_out) { row = col = 0; return; } ioctl(fd_out, TIOCGWINSZ, &ws); nb_rows = *row = ws.ws_row; nb_cols = *col = ws.ws_col; #elif defined(_WIN32) CONSOLE_SCREEN_BUFFER_INFO csbi; if (GetConsoleScreenBufferInfo(h_stdout, &csbi)) { *row = csbi.dwSize.Y; *col = csbi.dwSize.X; } else { *row = 25; *col = 80; } #endif } /*-------------------------------------------------------------------------* * PL_LE_IS_INTERRUPT_KEY * * * *-------------------------------------------------------------------------*/ int Pl_LE_Is_Interrupt_Key(int c) { return (c == interrupt_key); } /*-------------------------------------------------------------------------* * PL_LE_KBD_IS_NOT_EMPTY * * * *-------------------------------------------------------------------------*/ int Pl_LE_Kbd_Is_Not_Empty(void) { #if defined(__unix__) || defined(__CYGWIN__) #ifdef FIONREAD int nb_not_read; ioctl(fd_in, FIONREAD, &nb_not_read); return nb_not_read != 0; #else return 0; #endif #elif defined(_WIN32) return kbhit(); #endif } /*-------------------------------------------------------------------------* * PL_LE_INS_MODE * * * *-------------------------------------------------------------------------*/ void Pl_LE_Ins_Mode(int ins_mode) { #if defined(_WIN32) && !defined(__CYGWIN__) CONSOLE_CURSOR_INFO cci; if (!GetConsoleCursorInfo(h_stdout, &cci)) return; cci.dwSize = (ins_mode) ? 5 : 50; SetConsoleCursorInfo(h_stdout, &cci); #endif } /*-------------------------------------------------------------------------* * PL_LE_EMIT_BEEP * * * *-------------------------------------------------------------------------*/ void Pl_LE_Emit_Beep(void) { #if defined(__unix__) || defined(__CYGWIN__) Pl_LE_Put_Char('\a'); #else Beep(800, 220); #endif } /* * Character I/O */ /*-------------------------------------------------------------------------* * PL_LE_PUT_CHAR * * * *-------------------------------------------------------------------------*/ void Pl_LE_Put_Char(int c) { #if defined(__unix__) || defined(__CYGWIN__) char c0 = c; if (use_ansi) { char buf[20]; switch(c) { case '\b': if (pos == 0) { pos = nb_cols - 1; sprintf(buf, "\033[A\033[%dC", pos); if (write(fd_out, buf, strlen(buf))) /* to avoid gcc warning warn_unused_result */ { } return; } pos--; break; case '\a': break; case '\n': pos = 0; break; default: if (++pos > nb_cols) pos = 1; } } c0 = c; if (write(fd_out, &c0, 1)) /* to avoid gcc warning warn_unused_result */ { } #elif defined(_WIN32) CONSOLE_SCREEN_BUFFER_INFO csbi; if (c != '\b') { if (oem_put) { char buff[2]; buff[0] = c; buff[1] = '\0'; CharToOem(buff, buff); c = buff[0]; } #if 0 putch(c); #else /* replacement of putch() same but a bit faster */ { DWORD nb; char c0 = (char) c; WriteConsole(h_stdout, &c0, 1, &nb, NULL); } #endif return; } GetConsoleScreenBufferInfo(h_stdout, &csbi); if (csbi.dwCursorPosition.X == 0) { csbi.dwCursorPosition.X = csbi.dwSize.X - 1; csbi.dwCursorPosition.Y--; } else csbi.dwCursorPosition.X--; SetConsoleCursorPosition(h_stdout, csbi.dwCursorPosition); #endif } /*-------------------------------------------------------------------------* * PL_LE_GET_CHAR * * * *-------------------------------------------------------------------------*/ int Pl_LE_Get_Char(void) { int c = GET_CHAR0; if (c == 0x1b) { int esc_c = GET_CHAR0; #if defined(__unix__) || defined(__CYGWIN__) int modif = 0; int double_bracket = 0; int number[2] = {0, 0}; int idx_number = 0; if (esc_c == 0x1b) /* CYGWIN ESC CSI ... = ALT modif + CSI ... */ { modif = 2; /* ALT */ esc_c = GET_CHAR0; } if (esc_c == '[' || esc_c == 'O') /* keyboard ANSI ESC sequence (CSI or SS3) */ { if ((esc_c = GET_CHAR0) == '[') /* CYGWIN ESC [ [ A = F1 ... ESC [ [ E= F5 */ { esc_c = GET_CHAR0; double_bracket = 1; } while(isdigit(esc_c) || esc_c == ';') { if (esc_c == ';') idx_number = 1 - idx_number; else number[idx_number] = number[idx_number] * 10 + esc_c - '0'; esc_c = GET_CHAR0; } c = number[0]; if (number[1]) modif |= (number[1] - 1); if (isupper(esc_c)) { if (double_bracket) c = esc_c - 'A' + 11; /* CYGWIN F1 ..F5 = CSI [ A .. CSI [ E map to 11-15 */ else if (esc_c >= 'P') /* ANSY F1 .. F4 SS3 P .. SS3 Q map to 11-15*/ c = esc_c - 'P' + 11; else c = esc_c; } else if (esc_c == '^') /* CYGWIN CTRL + F1 .. F12 = CSI 11 ^ .. CSI 24 ^ */ { modif |= KEY_MODIF_CTRL; /* CTRL */ } else if (esc_c == '$') /* CYGWIN: shift+F11 = CSI 23 $ shift+F12 = CSI 24 $ */ { modif |= KEY_MODIF_SHIFT; } if (c == 1) /* CYGWIN: Home = CSI 1 ~ End = CSI 4 ~ */ c = 'H'; else if (c == 4) c = 'F'; else if (c >= 25 && c <= 36) /* CYGWIN: shift+F1 = F11, shift+F2=F12 shift+F3=25 */ { c = c - ((c <= 26 || c == 29) ? 12 : 13); modif |= KEY_MODIF_SHIFT; } c = KEY_ID2(modif, c); #if 0 printf("\n++++ key id: %d (%x) modif: %d end char: %c n[0]=%d n[1]=%d\n", c, c, modif, esc_c, number[0], number[1]); #endif } else #endif c = KEY_ESC(esc_c); } return c; } /*-------------------------------------------------------------------------* * LE_GET_CHAR0 * * * *-------------------------------------------------------------------------*/ static int LE_Get_Char0(void) { #if defined(__unix__) || defined(__CYGWIN__) unsigned char c; if (read(fd_in, &c, 1) != 1) return KEY_CTRL('D'); #if 0 { char s[32]; if (isprint(c)) s[0] = c, s[1] = '\0'; else if (c == 27) strcpy(s, (c == 27) ? "ESC": "???"); printf("char0: %d %s\n", c, s); } #endif return (int) c; #elif defined(_WIN32) INPUT_RECORD ir; DWORD nb; int modif = 0; int c; read_char: if (!ReadConsoleInput(GetStdHandle(STD_INPUT_HANDLE), &ir, 1, &nb) || nb != 1) return -1; switch (ir.EventType) { case KEY_EVENT: if (!ir.Event.KeyEvent.bKeyDown) goto read_char; c = ir.Event.KeyEvent.uChar.AsciiChar & 0xff; if (c == 0 || c == 0xe0) { c = ir.Event.KeyEvent.wVirtualKeyCode; if (c < 0x15 || c > 0x87) /* e.g. CTRL key alone */ goto read_char; if (ir.Event.KeyEvent.dwControlKeyState & (SHIFT_PRESSED)) modif |= KEY_MODIF_SHIFT; if (ir.Event.KeyEvent.dwControlKeyState & (LEFT_ALT_PRESSED | RIGHT_ALT_PRESSED)) modif |= KEY_MODIF_ALT; if (ir.Event.KeyEvent.dwControlKeyState & (LEFT_CTRL_PRESSED | RIGHT_CTRL_PRESSED)) modif |= KEY_MODIF_CTRL; c = KEY_ID2(modif, c); } else if (oem_get) { char buff[2]; buff[0] = c; buff[1] = '\0'; OemToChar(buff, buff); c = buff[0]; } break; case MOUSE_EVENT: case WINDOW_BUFFER_SIZE_EVENT: case MENU_EVENT: case FOCUS_EVENT: goto read_char; break; } return c; #endif } /*-------------------------------------------------------------------------* * BACKD * * * *-------------------------------------------------------------------------*/ static void Backd(int n) { while (n--) PUT_CHAR('\b'); } /*-------------------------------------------------------------------------* * FORWD * * * *-------------------------------------------------------------------------*/ static void Forwd(int n, char *str) { while (n--) PUT_CHAR(*str++); } /*-------------------------------------------------------------------------* * DISPL * * * *-------------------------------------------------------------------------*/ static void Displ(int n, char *str) { while (n--) PUT_CHAR(*str++); } /*-------------------------------------------------------------------------* * ERASE * * * *-------------------------------------------------------------------------*/ static void Erase(int n) { int n0 = n; while (n--) PUT_CHAR(' '); BACKD(n0); } /*-------------------------------------------------------------------------* * DISPL_STR * * * *-------------------------------------------------------------------------*/ static void Displ_Str(char *str) { while (*str) PUT_CHAR(*str++); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/test_linedit.c������������������������������������������������������������0000644�0001750�0001750�00000017614�13021324543�016342� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : test_linedit.c * * Descr.: test file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <ctype.h> #include <string.h> #include <time.h> #define printf Pl_LE_Printf #include "../EnginePl/gp_config.h" #include "../EnginePl/set_locale.h" #include "../W32GUICons/w32gc_interf.h" /* only to test GUI Console memory size dialog box */ int pl_max_atom; /* to test the same dialog box */ #ifdef GUI_CONSOLE_WITH_STACK_SIZES #define ENGINE_FILE /* to define stacks data */ typedef PlLong WamWord; #include "../EnginePl/wam_stacks.h" #endif #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #else #include <io.h> #include <process.h> #endif #include "ctrl_c.h" #include "linedit.h" /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_SIZE 500000 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * CTRL_C_MANAGER * * * *-------------------------------------------------------------------------*/ PlLong Ctrl_C_Manager(int from_callback) { int c; char prefix[100]; char *str; int nb, max_lg, is_last; printf("\nCATCHING CTRL+C prompt length: %d current pos: %d\n", Pl_LE_Get_Prompt_Length(), Pl_LE_Get_Current_Position()); printf("e: exit, c: continue, C: completions, w: current word: "); fflush(stdout); c = Pl_LE_Get_Key(1, 1); printf("\n"); switch (c) { case 'e': exit(0); case 'w': Pl_LE_Get_Current_Word(prefix); printf("current word=<%s>\n", prefix); break; case 'C': printf("Enter a prefix:"); Pl_LE_Gets(prefix); if ((str = Pl_LE_Compl_Init_Match(prefix, &nb, &max_lg)) == NULL) printf("no matching\n"); else { printf("common=<%s> nb=%d max_lg=%d\n", str, nb, max_lg); while ((str = Pl_LE_Compl_Find_Match(&is_last)) != NULL) printf("matching: <%s>\n", str); } break; } return 0; } /*-------------------------------------------------------------------------* * SET_TEST_LOCALE * * * *-------------------------------------------------------------------------*/ void Set_Test_Locale(void) { time_t ltime; struct tm *thetime; char str[100]; /* char c = 'é';*/ Set_Locale(); printf("Locale: %s\n", setlocale(LC_ALL, NULL)); printf("Is char 233 (= %c) an alpha ? %s\n", 233, (isalpha(233) ? "YES": "NO")); time(<ime); thetime = gmtime(<ime); strftime(str, 100, "%d (%A) %m (%B) %Y", thetime); printf("Date in current locale with strftime: %s\n", str); printf("Float should be independent from locale pi: %f\n", 3.1415); } /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { static char line[MAX_SIZE]; char *p; char sep[100]; int ret_val; int tempo = 0; #if defined(_WIN32) && !defined(__CYGWIN__) setbuf(stdout, NULL); setbuf(stderr, NULL); #endif #if 1 Pl_Install_Ctrl_C_Handler(Ctrl_C_Manager); #endif Set_Test_Locale(); if (argc > 1) tempo = atoi(argv[1]); sep[0] = '\n'; strcpy(sep + 1, Pl_LE_Get_Separators()); printf("enter lines (EOF to finish)\n"); #if 0 { /* test space overflow in WIN32 GUI console */ int i; char buf[256]; for (i = 0; i < 280; i++) { sprintf(buf, "line %3d tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt\n", i); printf(buf); } } #endif for (;;) { #ifdef __unix__ if (tempo) { printf("tempo %d secs to allow you to buffer some chars:\n"); sleep(tempo); } #endif #if 0 printf("enter a line:"); if (Pl_LE_Gets(line) == NULL) #else if (Pl_LE_FGets(line, MAX_SIZE, "enter a line:", 1) == NULL) #endif break; printf("Line:(%s) len:%d\n", line, strlen(line)); for (p = line; (p = strtok(p, sep)) != NULL; p = NULL) { printf("adding word (%s) for completion\n", p); Pl_LE_Compl_Add_Word(strdup(p), strlen(p)); } #if 0 // test an exception (under Win32 relaunch automatically the main !!! why ? if (*line == 'k' && line[1] == '\0') { *(int *) 12 = 45; } #endif } printf("End of testing\n"); ret_val = 12; if (pl_le_hook_exit_process) (*pl_le_hook_exit_process) (ret_val); return ret_val; } ��������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/ctrl_c.h������������������������������������������������������������������0000644�0001750�0001750�00000006362�13021324543�015124� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : ctrl_c.c * * Descr.: Ctrl+C management - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Install_Ctrl_C_Handler(PlLong (*handler) (int)); PlLong Pl_Emit_Ctrl_C(void); ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/Makefile.in���������������������������������������������������������������0000644�0001750�0001750�00000003202�13021324543�015540� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������LIB_LINEDIT = @LIB_LINEDIT@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ CFLAGS_UNSIGNED_CHAR = @CFLAGS_UNSIGNED_CHAR@ LDLIBS = @LDLIBS@ AR_RC = @AR_RC@ RANLIB = @RANLIB@ LIBNAME = $(LIB_LINEDIT) OBJLIB = linedit@OBJ_SUFFIX@ terminal@OBJ_SUFFIX@ ctrl_c@OBJ_SUFFIX@ .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .c $(SUFFIXES) all: $(LIBNAME) .c@OBJ_SUFFIX@: $(CC) -c $(CFLAGS) $(CFLAGS_UNSIGNED_CHAR) $*.c $(LIBNAME): $(OBJLIB) rm -f $(LIBNAME) $(AR_RC)@AR_SEP@$(LIBNAME) $(OBJLIB) $(RANLIB) $(LIBNAME) terminal@OBJ_SUFFIX@: terminal.h clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp $(LIBNAME) distclean: clean rm -f test_linedit@EXE_SUFFIX@ test_noecho@EXE_SUFFIX@ # test files # under win32: use make W=Y test_linedit.exe (or test_noecho.exe) to # link the GUI console # You can also use gplc test_linedit.c and gplc --gui-console test_linedit.c # even linking the GUI console you can set the env var NO_LE_HOOK to avoid it W32LNK=..\W32GUICons\w32gc_interf@OBJ_SUFFIX@ # /link /subsystem:windows (remove the console, obsolete now) test_linedit@EXE_SUFFIX@: test_linedit@OBJ_SUFFIX@ $(LIBNAME) if [ "$$W" != "Y" ]; then W=''; else W="$(W32LNK)"; fi; \ $(CC) @CC_EXE_NAME_OPT@test_linedit@EXE_SUFFIX@ test_linedit@OBJ_SUFFIX@ $(LIBNAME) $(LDLIBS) $$W test_noecho@EXE_SUFFIX@: test_noecho@OBJ_SUFFIX@ $(LIBNAME) if [ "$$W" != "Y" ]; then W=''; else W="$(W32LNK)"; fi; \ $(CC) @CC_EXE_NAME_OPT@test_noecho@EXE_SUFFIX@ test_noecho@OBJ_SUFFIX@ $(LIBNAME) $(LDLIBS) $$W clean-test: rm -f test*@OBJ_SUFFIX@ test_linedit@EXE_SUFFIX@ test_noecho@EXE_SUFFIX@ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Linedit/linedit.h�����������������������������������������������������������������0000644�0001750�0001750�00000014064�13021324543�015304� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : line-edit library * * File : linedit.h * * Descr.: line editor - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /* Windows uses 2 codepages (which give the meaning of 0x80..0xFF chars): * "OEM codepages" for console programs and "ANSI codepages" for GUI programs. * For instance 'é' (\'e) is returned as 130 in OEM (with codepage 850) and * as 233 in ANSI. The problem is that isalpha(130) is false... * I use 2 Win32 functions: OemToChar() (when reading) and CharToOem() * (when writing)... */ #if 1 #define WIN32_CONVERT_OEM_ASCII #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ enum { LE_MODE_DEACTIVATED = 0, /* linedit is deactivated */ LE_MODE_TTY, /* linedit runs in console mode */ LE_MODE_HOOK /* linedit runs via a hook (i.e. GUI) */ }; /*---------------------------------* * Global Variables * *---------------------------------*/ /* overwritten if needed to customize linedit */ void (*pl_le_hook_start) (); /* is it mandatory to define a hook ? */ void (*pl_le_hook_put_char) (); /* mandatory */ int (*pl_le_hook_get_char0) (); /* mandatory */ void (*pl_le_hook_emit_beep) (); void (*pl_le_hook_ins_mode) (); void (*pl_le_hook_screen_size) (); /* mandatory */ int (*pl_le_hook_kbd_is_not_empty) (); /* mandatory */ void (*pl_le_hook_backd) (); void (*pl_le_hook_forwd) (); void (*pl_le_hook_displ) (); void (*pl_le_hook_displ_str) (); void (*pl_le_hook_erase) (); /* functions not used by linedit itself */ void (*pl_le_hook_set_line_buffering) (); int (*pl_le_hook_get_line_buffering) (); void (*pl_le_hook_flush) (); int (*pl_le_hook_confirm_box) (); void (*pl_le_hook_message_box) (); void (*pl_le_hook_exit_process) (); #ifdef LE_DEFINE_HOOK_MACROS #define EMIT_BEEP ((*pl_le_hook_emit_beep)()) #define PUT_CHAR(c) ((*pl_le_hook_put_char)(c)) #define GET_CHAR0 ((*pl_le_hook_get_char0)()) #define INS_MODE(ins_mode) ((*pl_le_hook_ins_mode)(ins_mode)) #define SCREEN_SIZE(r, c) ((*pl_le_hook_screen_size)(r, c)) #define KBD_IS_NOT_EMPTY ((*pl_le_hook_kbd_is_not_empty)()) #define BACKD(n) ((*pl_le_hook_backd)(n)) #define FORWD(n, str) ((*pl_le_hook_forwd)(n, str)) #define DISPL(n, str) ((*pl_le_hook_displ)(n, str)) #define DISPL_STR(str) ((*pl_le_hook_displ_str)(str)) #define ERASE(n) ((*pl_le_hook_erase)(n)) #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Pl_LE_Initialize(void); char *Pl_LE_Gets(char *str); char *Pl_LE_FGets(char *str, int size, char *prompt, int display_prompt); PlLong Pl_LE_Get_Ctrl_C_Return_Value(void); #define LE_Interrupted_By_Ctrl_C(r) ((PlLong) r == (PlLong) -2) int Pl_LE_Get_Prompt_Length(void); int Pl_LE_Get_Current_Position(void); void Pl_LE_Get_Current_Word(char *word); char *Pl_LE_Get_Separators(void); char *Pl_LE_Set_Separators(char *sep_str); char *Pl_LE_Compl_Add_Word(char *word, int word_length); char *Pl_LE_Compl_Del_Word(char *word); char *Pl_LE_Compl_Init_Match(char *prefix, int *nb_match, int *max_lg); char *Pl_LE_Compl_Find_Match(int *is_last); int Pl_LE_Get_Key(int echo, int catch_ctrl_c); int Pl_LE_Printf(char *format, ...); #ifdef TERMINAL_FILE int (*pl_le_initialize)() = Pl_LE_Initialize; #else int (*pl_le_initialize)(); #endif ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/���������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013214� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/syn_sugar.wam��������������������������������������������������������������0000644�0001750�0001750�00000100704�13021356407�015736� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : syn_sugar.pl file_name('/home/diaz/GP/src/Pl2Wam/syn_sugar.pl'). predicate(user:syntactic_sugar_init_pred/2,40,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), call('$aux_name'/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_atom(aux,0), put_integer(1,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed]). predicate(user:syntactic_sugar/3,49,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_value(y(0),1), put_variable(y(3),2), call('$syntactic_sugar/3_$aux1'/3), cut(y(2)), put_value(y(3),0), put_variable(y(4),1), call(normalize_cuts/2), put_unsafe_value(y(4),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(normalize_alts/3)]). predicate(user:'$syntactic_sugar/3_$aux1'/3,49,static,private,monofile,local,[ try_me_else(1), get_structure((:-)/2,0), unify_local_value(x(1)), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_value(x(1),0), get_atom(true,2), proceed]). predicate(user:normalize_cuts/2,59,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(has_cut,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_variable(y(3),0), call(get_module_of_cur_pred/1), put_value(y(0),0), put_value(y(3),1), put_variable(y(4),2), put_variable(y(5),3), call(normalize_cuts1/4), cut(y(2)), put_value(y(1),0), put_unsafe_value(y(4),1), put_unsafe_value(y(5),2), deallocate, execute('$normalize_cuts/2_$aux1'/3)]). predicate(user:'$normalize_cuts/2_$aux1'/3,59,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), put_atom(has_cut,4), put_atom(t,5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), get_structure((',')/2,0), unify_variable(x(0)), unify_local_value(x(2)), get_structure('$get_cut_level'/1,0), unify_local_value(x(1)), proceed, label(1), trust_me_else_fail, get_value(x(2),0), proceed]). predicate(user:normalize_cuts1/4,95,static,private,monofile,global,[ try_me_else(1), get_variable(x(4),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(4)]), put_structure(call/1,0), unify_local_value(x(4)), execute(normalize_cuts1/4), label(1), retry_me_else(24), switch_on_term(4,11,fail,fail,2), label(2), switch_on_structure([((;)/2,3),((->)/2,7),((*->)/2,9),((',')/2,13),((:)/2,17),(call/1,19),(catch/3,21),(throw/1,23)]), label(3), try(5), trust(15), label(4), try_me_else(6), label(5), allocate(8), get_variable(y(1),1), get_variable(y(2),2), get_structure((;)/2,0), unify_variable(x(0)), unify_variable(y(0)), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),4), put_variable(y(6),5), put_variable(y(7),6), call('$normalize_cuts1/4_$aux1'/7), put_value(y(3),0), put_value(y(5),1), call(normalize_cuts_in_if/2), put_value(y(4),0), put_value(y(1),1), put_value(y(2),2), put_value(y(6),3), call(normalize_cuts1/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(7),3), deallocate, execute(normalize_cuts1/4), label(6), retry_me_else(8), label(7), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_structure((->)/2,0), unify_variable(x(0)), unify_variable(y(0)), get_structure((;)/2,3), unify_variable(x(1)), unify_atom(fail), get_structure((',')/2,1), unify_variable(x(2)), unify_structure((',')/2), unify_variable(x(1)), unify_structure((',')/2), unify_variable(x(3)), unify_variable(y(3)), get_structure('$get_cut_level'/1,2), unify_variable(x(2)), get_structure('$cut'/1,3), unify_value(x(2)), call(normalize_cuts_in_if/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(normalize_cuts1/4), label(8), retry_me_else(10), label(9), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_structure((*->)/2,0), unify_variable(x(0)), unify_variable(y(0)), get_structure((;)/2,3), unify_variable(x(1)), unify_atom(fail), get_structure((',')/2,1), unify_variable(x(1)), unify_variable(y(3)), call(normalize_cuts_in_if/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(normalize_cuts1/4), label(10), retry_me_else(12), label(11), get_atom(!,0), get_structure('$cut'/1,3), unify_local_value(x(2)), put_atom(has_cut,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(12), retry_me_else(14), label(13), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), get_structure((',')/2,3), unify_variable(x(3)), unify_variable(y(3)), put_value(y(1),1), put_value(y(2),2), call(normalize_cuts1/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(normalize_cuts1/4), label(14), retry_me_else(16), label(15), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_structure((;)/2,0), unify_variable(x(0)), unify_variable(y(0)), get_structure((;)/2,3), unify_variable(x(3)), unify_variable(y(3)), put_value(y(1),1), put_value(y(2),2), call(normalize_cuts1/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(normalize_cuts1/4), label(16), retry_me_else(18), label(17), allocate(4), get_structure((:)/2,0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), call(check_module_name_qualif/1), put_value(y(1),0), put_value(y(0),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(normalize_cuts1/4), label(18), retry_me_else(20), label(19), get_structure(call/1,0), unify_variable(x(0)), get_structure('$call'/4,3), unify_value(x(0)), unify_local_value(x(1)), unify_variable(x(0)), unify_variable(x(1)), execute(cur_pred_without_aux/2), label(20), retry_me_else(22), label(21), get_structure(catch/3,0), unify_variable(x(4)), unify_variable(x(2)), unify_variable(x(0)), get_structure('$catch'/6,3), unify_value(x(4)), unify_value(x(2)), unify_value(x(0)), unify_local_value(x(1)), unify_variable(x(0)), unify_variable(x(1)), execute(cur_pred_without_aux/2), label(22), trust_me_else_fail, label(23), allocate(2), get_structure(throw/1,0), unify_variable(x(0)), get_structure('$throw'/4,3), unify_value(x(0)), unify_variable(x(0)), unify_variable(y(0)), unify_variable(y(1)), call(get_module_of_cur_pred/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute(cur_pred_without_aux/2), label(24), retry_me_else(25), get_variable(x(4),1), get_variable(x(1),0), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(1)]), put_value(x(4),0), execute('$normalize_cuts1/4_$aux2'/4), label(25), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('body goal is not callable (~q)',0), execute(error/2)]). predicate(user:'$normalize_cuts1/4_$aux2'/4,149,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_variable(x(5),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), cut(x(4)), put_structure(call/1,0), unify_local_value(x(5)), execute(normalize_cuts1/4), label(1), retry_me_else(2), allocate(3), get_variable(y(0),1), get_variable(y(1),3), get_variable(y(2),4), put_value(y(0),1), call(useless_module_qualification/2), cut(y(2)), put_value(y(1),0), get_value(y(0),0), deallocate, proceed, label(2), trust_me_else_fail, get_structure((:)/2,3), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(user:'$normalize_cuts1/4_$aux1'/7,99,static,private,monofile,local,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([((->)/2,3),((*->)/2,5)]), label(2), try_me_else(4), label(3), get_structure((->)/2,0), unify_local_value(x(1)), unify_local_value(x(2)), get_structure((;)/2,3), unify_variable(x(0)), unify_local_value(x(6)), get_structure((',')/2,0), unify_variable(x(0)), unify_structure((',')/2), unify_local_value(x(4)), unify_structure((',')/2), unify_variable(x(1)), unify_local_value(x(5)), get_structure('$get_cut_level'/1,0), unify_variable(x(0)), get_structure('$cut'/1,1), unify_value(x(0)), proceed, label(4), trust_me_else_fail, label(5), get_structure((*->)/2,0), unify_local_value(x(1)), unify_local_value(x(2)), get_structure((;)/2,3), unify_variable(x(0)), unify_local_value(x(6)), get_structure((',')/2,0), unify_variable(x(0)), unify_structure((',')/2), unify_local_value(x(4)), unify_structure((',')/2), unify_variable(x(1)), unify_local_value(x(5)), get_structure('$get_current_choice'/1,0), unify_variable(x(0)), get_structure('$soft_cut'/1,1), unify_value(x(0)), proceed]). predicate(user:normalize_cuts_in_if/2,171,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_structure('$force_aux_pred'/1,1), unify_variable(x(1)), get_variable(y(0),2), put_atom(has_cut,2), put_variable(y(1),3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), put_atom(has_cut,2), put_atom(f,3), call_c('Pl_Blt_G_Assign',[fast_call],[x(2),x(3)]), call(normalize_cuts/2), put_atom(has_cut,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_atom(has_cut,1), put_unsafe_value(y(1),2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), get_atom(t,0), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(1),0), proceed]). predicate(user:useless_module_qualification/2,185,static,private,monofile,global,[ try_me_else(6), switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(system,3),(user,5)]), label(2), try_me_else(4), label(3), get_atom(system,0), proceed, label(4), trust_me_else_fail, label(5), get_atom(user,0), proceed, label(6), retry_me_else(7), execute(get_module_of_cur_pred/1), label(7), trust_me_else_fail, put_atom(system,2), execute('$get_module_of_goal'/3)]). predicate(user:normalize_alts/3,198,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), allocate(1), get_variable(y(0),3), put_variable(x(5),3), put_variable(x(4),6), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(3),x(6)]), put_atom(head_functor,3), call_c('Pl_Blt_G_Assign',[fast_call],[x(3),x(5)]), put_atom(head_arity,3), call_c('Pl_Blt_G_Assign',[fast_call],[x(3),x(4)]), call(normalize_alts1/3), cut(y(0)), deallocate, proceed]). predicate(user:normalize_alts1/3,205,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_structure(call/1,2), unify_local_value(x(0)), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), retry_me_else(2), allocate(4), get_structure((',')/2,0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),1), get_structure((',')/2,2), unify_variable(x(2)), unify_variable(y(3)), put_value(y(0),0), put_structure((',')/2,1), unify_local_value(y(2)), unify_value(y(1)), call(normalize_alts1/3), put_value(y(1),0), put_structure((',')/2,1), unify_local_value(y(2)), unify_value(y(0)), put_value(y(3),2), deallocate, execute(normalize_alts1/3), label(2), retry_me_else(3), allocate(9), get_variable(y(0),1), get_variable(y(1),2), put_variable(y(2),1), call('$normalize_alts1/3_$aux1'/2), put_value(y(0),0), put_nil(1), put_variable(y(3),2), call(lst_var/3), put_value(y(2),0), put_nil(1), put_variable(y(4),2), call(lst_var/3), put_value(y(4),0), put_value(y(3),1), put_variable(y(5),2), call(set_inter/3), put_value(y(5),0), put_variable(y(6),1), call(length/2), put_atom(head_functor,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_atom(head_arity,2), put_variable(x(1),3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), put_variable(y(7),2), put_value(y(6),3), call(init_aux_pred_name/4), put_value(y(1),0), put_list(1), unify_local_value(y(7)), unify_local_value(y(5)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(0),x(1)]), put_atom(where,0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(2),0), put_value(y(1),1), put_variable(y(8),3), call(linearize/4), put_structure(buff_aux_pred/3,0), unify_local_value(y(7)), unify_local_value(y(6)), unify_local_value(y(8)), put_meta_term(user,0,0), deallocate, execute(asserta/1), label(3), trust_me_else_fail, allocate(3), get_variable(y(0),2), get_variable(y(1),3), put_variable(y(2),1), call(meta_pred_rewriting/2), put_value(y(2),0), put_value(y(0),1), call(pred_rewriting/2), cut(y(1)), deallocate, proceed]). predicate(user:'$normalize_alts1/3_$aux1'/2,212,static,private,monofile,local,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([((;)/2,3),('$force_aux_pred'/1,5)]), label(2), try_me_else(4), label(3), get_structure((;)/2,0), unify_void(2), get_value(x(0),1), proceed, label(4), trust_me_else_fail, label(5), get_structure('$force_aux_pred'/1,0), unify_local_value(x(1)), proceed]). predicate(user:init_aux_pred_name/4,233,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_atom(aux,0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(x(2),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(1)],[x(0)]), put_atom(aux,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_value(y(2),3), call('$make_aux_name'/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), call('$init_aux_pred_name/4_$aux1'/4), cut(y(4)), deallocate, proceed]). predicate(user:'$init_aux_pred_name/4_$aux1'/4,233,static,private,monofile,local,[ try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(y(1),3), get_variable(x(2),1), put_value(x(0),1), put_atom(bpl,0), call(test_pred_info/3), put_atom(bpl,0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(set_pred_info/3), label(1), retry_me_else(2), allocate(2), get_variable(y(0),2), get_variable(y(1),3), get_variable(x(2),1), put_value(x(0),1), put_atom(bfd,0), call(test_pred_info/3), put_atom(bfd,0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(set_pred_info/3), label(2), trust_me_else_fail, proceed]). predicate(user:linearize/4,248,static,private,monofile,global,[ execute('$linearize/4_$aux1'/4)]). predicate(user:'$linearize/4_$aux1'/4,248,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(6), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_structure((;)/2,0), unify_variable(y(3)), unify_variable(x(0)), cut(x(4)), put_value(y(0),1), put_value(y(1),2), put_variable(y(4),3), call(linearize/4), put_value(y(3),0), put_value(y(0),1), put_value(y(1),2), put_variable(y(5),3), call(linearize1/4), put_unsafe_value(y(5),0), put_unsafe_value(y(4),1), put_value(y(2),2), deallocate, execute(append/3), label(1), trust_me_else_fail, execute(linearize1/4)]). predicate(user:linearize1/4,257,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_atom(fail,0), get_nil(3), cut(x(4)), proceed, label(1), trust_me_else_fail, get_variable(x(5),1), get_variable(x(4),0), get_list(3), unify_variable(x(0)), unify_nil, get_structure((+)/2,0), unify_local_value(x(2)), unify_variable(x(1)), put_structure((:-)/2,0), unify_local_value(x(5)), unify_local_value(x(4)), execute(copy_term/2)]). predicate(user:lst_var/3,266,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_variable(x(4),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), cut(x(3)), put_value(x(4),0), execute(set_add/3), label(1), trust_me_else_fail, get_variable(x(4),2), get_variable(x(3),1), put_void(2), put_variable(x(1),5), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(2),x(5)]), put_value(x(0),2), put_integer(1,0), execute(lst_var_args/5)]). predicate(user:lst_var_args/5,276,static,private,monofile,global,[ execute('$lst_var_args/5_$aux1'/5)]). predicate(user:'$lst_var_args/5_$aux1'/5,276,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),4), math_fast_load_value(y(0),0), math_fast_load_value(y(1),1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), cut(x(5)), put_value(y(0),1), put_value(y(2),2), put_variable(x(0),4), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(1),x(2),x(4)]), put_value(x(3),1), put_variable(y(4),2), call(lst_var/3), math_fast_load_value(y(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(4),3), put_value(y(3),4), deallocate, execute(lst_var_args/5), label(1), trust_me_else_fail, get_value(x(3),4), proceed]). predicate(user:pred_rewriting/2,290,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(6), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(fd_tell/1,3),(set_bip_name/2,5)]), label(2), try_me_else(4), label(3), allocate(2), get_structure(fd_tell/1,0), unify_variable(y(0)), get_variable(y(1),1), put_structure((/)/2,0), unify_atom(fd_tell), unify_integer(1), call(test_c_call_allowed/1), put_structure('$call_c'/2,0), unify_value(y(0)), unify_list, unify_atom(boolean), unify_nil, put_value(y(1),1), deallocate, execute(pred_rewriting/2), label(4), trust_me_else_fail, label(5), allocate(2), get_variable(y(0),1), get_structure(set_bip_name/2,0), unify_variable(x(0)), unify_variable(x(1)), put_atom(inline,2), put_atom(t,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), put_variable(y(1),2), call('$pred_rewriting/2_$aux1'/3), put_unsafe_value(y(1),0), put_value(y(0),1), deallocate, execute(pred_rewriting/2), label(6), retry_me_else(7), allocate(4), get_variable(y(0),0), get_variable(y(1),1), put_atom(inline,0), put_atom(t,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(fast_math,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_variable(y(2),1), put_integer(2,2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_value(y(2),0), call('$pred_rewriting/2_$aux2'/1), put_structure(set_bip_name/2,0), unify_local_value(y(2)), unify_integer(2), put_variable(y(3),1), call(pred_rewriting/2), put_value(y(1),0), get_structure((',')/2,0), unify_local_value(y(3)), unify_local_value(y(0)), deallocate, proceed, label(7), retry_me_else(21), switch_on_term(9,fail,fail,fail,8), label(8), switch_on_structure([(term_hash/2,10),(term_hash/4,12),('$call_c'/2,14),('$call_c'/1,16),('$call_c_test'/1,18),('$call_c_jump'/1,20)]), label(9), try_me_else(11), label(10), allocate(6), get_variable(y(1),1), get_structure(term_hash/2,0), unify_variable(x(1)), unify_variable(y(0)), get_variable(y(2),2), put_atom(inline,0), put_atom(t,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), put_structure(term_hash/2,0), unify_value(x(1)), unify_variable(y(3)), put_void(1), put_atom(fail,2), put_atom(user,3), put_atom(pred_rewriting,4), put_integer(2,5), call('$catch'/6), put_value(y(3),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), cut(y(2)), put_structure(set_bip_name/2,0), unify_atom(term_hash), unify_integer(2), put_variable(y(4),1), call(pred_rewriting/2), put_structure('Pl_Un_Integer_Check'/2,1), unify_value(y(3)), unify_value(y(0)), put_structure('$call_c'/2,0), unify_value(x(1)), unify_list, unify_atom(boolean), unify_nil, put_variable(y(5),1), call(pred_rewriting/2), put_value(y(1),0), get_structure((',')/2,0), unify_local_value(y(4)), unify_local_value(y(5)), deallocate, proceed, label(11), retry_me_else(13), label(12), allocate(6), get_variable(y(1),1), get_structure(term_hash/4,0), unify_variable(x(4)), unify_variable(x(3)), unify_variable(x(1)), unify_variable(y(0)), get_variable(y(2),2), put_atom(inline,0), put_atom(t,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), put_structure(term_hash/4,0), unify_value(x(4)), unify_value(x(3)), unify_value(x(1)), unify_variable(y(3)), put_void(1), put_atom(fail,2), put_atom(user,3), put_atom(pred_rewriting,4), put_integer(2,5), call('$catch'/6), put_value(y(3),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), cut(y(2)), put_structure(set_bip_name/2,0), unify_atom(term_hash), unify_integer(4), put_variable(y(4),1), call(pred_rewriting/2), put_structure('Pl_Un_Integer_Check'/2,1), unify_value(y(3)), unify_value(y(0)), put_structure('$call_c'/2,0), unify_value(x(1)), unify_list, unify_atom(boolean), unify_list, unify_atom(by_value), unify_nil, put_variable(y(5),1), call(pred_rewriting/2), put_value(y(1),0), get_structure((',')/2,0), unify_local_value(y(4)), unify_local_value(y(5)), deallocate, proceed, label(13), retry_me_else(15), label(14), allocate(2), get_structure('$call_c'/2,0), unify_variable(x(0)), unify_variable(y(0)), get_structure('$call_c'/2,1), unify_value(x(0)), unify_variable(y(1)), put_structure((/)/2,0), unify_atom('$call_c'), unify_integer(2), call(test_c_call_allowed/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute(no_internal_transf/2), label(15), retry_me_else(17), label(16), allocate(2), get_structure('$call_c'/1,0), unify_variable(y(0)), get_variable(y(1),1), put_structure((/)/2,0), unify_atom('$call_c'), unify_integer(1), call(test_c_call_allowed/1), put_structure('$call_c'/2,0), unify_value(y(0)), unify_nil, put_value(y(1),1), deallocate, execute(pred_rewriting/2), label(17), retry_me_else(19), label(18), allocate(2), get_structure('$call_c_test'/1,0), unify_variable(y(0)), get_variable(y(1),1), put_structure((/)/2,0), unify_atom('$call_c_test'), unify_integer(1), call(test_c_call_allowed/1), put_structure('$call_c'/2,0), unify_value(y(0)), unify_list, unify_atom(boolean), unify_nil, put_value(y(1),1), deallocate, execute(pred_rewriting/2), label(19), trust_me_else_fail, label(20), allocate(2), get_structure('$call_c_jump'/1,0), unify_variable(y(0)), get_variable(y(1),1), put_structure((/)/2,0), unify_atom('$call_c_jump'), unify_integer(1), call(test_c_call_allowed/1), put_structure('$call_c'/2,0), unify_value(y(0)), unify_list, unify_atom(jump), unify_nil, put_value(y(1),1), deallocate, execute(pred_rewriting/2), label(21), trust_me_else_fail, get_value(x(1),0), proceed]). predicate(user:'$pred_rewriting/2_$aux2'/1,303,static,private,monofile,local,[ try_me_else(1), get_atom(is,0), proceed, label(1), trust_me_else_fail, put_void(1), execute(math_cmp_functor_name/2)]). predicate(user:'$pred_rewriting/2_$aux1'/3,294,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(1)]), cut(x(3)), get_structure('$call_c'/2,2), unify_variable(x(2)), unify_list, unify_atom(by_value), unify_nil, get_structure('Pl_Set_Bip_Name_Untagged_2'/2,2), unify_local_value(x(0)), unify_local_value(x(1)), proceed, label(1), trust_me_else_fail, get_structure('$call_c'/1,2), unify_structure('Pl_Set_Bip_Name_2'/2), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(user:test_c_call_allowed/1,363,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), put_atom(call_c,0), put_atom(t,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('~q not allowed in this mode',0), execute(error/2)]). predicate(user:not_dangerous_c_call/1,373,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(1)), unify_variable(x(0)), put_atom(jump,2), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(2)]), put_atom(use_x_regs,2), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(2)]), execute(not_dangerous_c_call/1)]). predicate(user:add_wrapper_to_dyn_clause/4,383,static,private,monofile,global,[ allocate(5), get_variable(y(0),1), get_structure((+)/2,2), unify_variable(y(1)), unify_variable(y(2)), get_variable(y(3),3), put_value(y(0),1), put_value(y(3),2), put_value(y(0),3), call(init_aux_pred_name/4), put_value(y(2),0), put_value(y(3),1), put_variable(y(4),2), call('$add_wrapper_to_dyn_clause/4_$aux1'/3), put_structure((+)/2,1), unify_value(y(1)), unify_local_value(y(4)), put_structure(buff_aux_pred/3,0), unify_local_value(y(3)), unify_local_value(y(0)), unify_list, unify_value(x(1)), unify_nil, put_meta_term(user,0,0), deallocate, execute(assertz/1)]). predicate(user:'$add_wrapper_to_dyn_clause/4_$aux1'/3,383,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(3), get_variable(y(0),2), get_structure((:-)/2,0), unify_variable(x(0)), unify_variable(y(1)), cut(x(3)), put_variable(y(2),2), call(head_wrapper/3), put_value(y(0),0), get_structure((:-)/2,0), unify_local_value(y(2)), unify_value(y(1)), deallocate, proceed, label(1), trust_me_else_fail, execute(head_wrapper/3)]). predicate(user:head_wrapper/3,393,static,private,monofile,global,[ put_list(4), unify_void(1), unify_variable(x(3)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(0),x(4)]), put_list(0), unify_local_value(x(1)), unify_value(x(3)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(2),x(0)]), proceed]). predicate(user:meta_pred_rewriting/2,401,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(0),0), put_variable(y(3),1), put_variable(y(4),2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_value(y(3),0), put_value(y(4),1), put_variable(y(5),2), call(get_meta_pred_decl/3), cut(y(2)), put_value(y(1),0), put_unsafe_value(y(3),1), put_unsafe_value(y(4),2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_integer(1,0), put_unsafe_value(y(4),1), put_value(y(0),2), put_unsafe_value(y(5),3), put_value(y(1),4), deallocate, execute(meta_pred_rewrite_args/5), label(1), trust_me_else_fail, get_value(x(1),0), proceed]). predicate(user:get_meta_pred_decl/3,412,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),3), put_structure(meta_pred/3,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), put_meta_term(user,3,0), put_void(1), call(clause/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), put_value(y(1),1), put_atom(built_in,2), call('$predicate_property1'/3), put_value(y(0),0), put_value(y(1),1), put_structure((meta_predicate)/1,2), unify_local_value(y(2)), call('$predicate_property1'/3), cut(y(3)), deallocate, proceed]). predicate(user:meta_pred_rewrite_args/5,421,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), math_fast_load_value(y(0),0), math_fast_load_value(y(1),1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), cut(x(5)), put_value(y(0),0), put_value(y(2),2), put_variable(x(1),3), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(0),x(2),x(3)]), put_value(y(0),0), put_value(y(4),3), put_variable(x(2),4), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(0),x(3),x(4)]), put_value(y(0),3), put_value(y(3),4), put_variable(x(0),5), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(3),x(4),x(5)]), call(meta_pred_rewrite_arg/3), math_fast_load_value(y(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute(meta_pred_rewrite_args/5), label(1), trust_me_else_fail, proceed]). predicate(user:meta_pred_rewrite_arg/3,435,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_value(x(2),1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), proceed, label(1), retry_me_else(2), get_atom(:,0), cut(x(3)), put_integer(0,0), execute(meta_pred_rewrite_arg/3), label(2), retry_me_else(3), get_variable(x(3),0), get_structure('$mt'/2,2), unify_variable(x(0)), unify_local_value(x(1)), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(3)]), execute(get_module_of_cur_pred/1), label(3), trust_me_else_fail, get_value(x(2),1), proceed]). ������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/inst_codif.pl��������������������������������������������������������������0000644�0001750�0001750�00000012636�13021324543�015676� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : inst_codif.pl * * Descr.: instruction codification (needed for register allocation) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ % alias stopping instructions alias_stop_instruction(InstW) :- functor(InstW, F, _), ( F = call ; F = execute ; F = call_c, arg(2, InstW, LCOpt), (memberchk(jump, LCOpt) ; memberchk(use_x_args, LCOpt)) ), !. % instruction codification codification(WamInst, LCode) :- codif(WamInst, LCode), !. codif(get_variable(x(Tmp), Arg), [c(Arg, Tmp)]). codif(get_value(x(Tmp), Arg), [r(Tmp), r(Arg)]). codif(get_variable(y(_), Arg), [r(Arg)]). codif(get_value(y(_), Arg), [r(Arg)]). codif(get_atom(_, Arg), [r(Arg)]). codif(get_integer(_, Arg), [r(Arg)]). codif(get_float(_, Arg), [r(Arg)]). codif(get_nil(Arg), [r(Arg)]). codif(get_list(Reg), [r(Reg)]). codif(get_structure(_, Reg), [r(Reg)]). codif(put_variable(x(Tmp), Arg), [w(Tmp), w(Arg)]). codif(put_void(Arg), [w(Arg)]). codif(put_value(x(Tmp), Arg), [c(Tmp, Arg)]). codif(put_variable(y(_), Arg), [w(Arg)]). codif(put_value(y(_), Arg), [w(Arg)]). codif(put_unsafe_value(y(_), Arg), [w(Arg)]). codif(put_atom(_, Arg), [w(Arg)]). codif(put_integer(_, Arg), [w(Arg)]). codif(put_float(_, Arg), [w(Arg)]). codif(put_nil(Arg), [w(Arg)]). codif(put_list(Reg), [w(Reg)]). codif(put_structure(_, Reg), [w(Reg)]). codif(put_meta_term(_, Reg1, Reg), [r(Reg1), w(Reg)]). codif(math_load_value(x(Reg), Tmp), [r(Reg), w(Tmp)]). codif(math_load_value(y(_), Tmp), [w(Tmp)]). codif(math_fast_load_value(x(Reg), Tmp), [r(Reg), w(Tmp)]). codif(math_fast_load_value(y(_), Tmp), [w(Tmp)]). codif(unify_variable(x(Tmp)), [w(Tmp)]). codif(unify_value(x(Tmp)), [r(Tmp)]). codif(unify_local_value(x(Tmp)), [r(Tmp)]). codif(call(T), LCode) :- ( T = _ / N ; T = _:_/N ), !, lst_r_for_call_execute(0, N, LCode). codif(execute(T), LCode) :- ( T = _ / N ; T = _:_/N ), !, lst_r_for_call_execute(0, N, LCode). codif(get_current_choice(x(Tmp)), [w(Tmp)]). codif(cut(x(Tmp)), [r(Tmp)]). codif(soft_cut(x(Tmp)), [r(Tmp)]). codif(call_c(_, LCOpt, LReg), LCode) :- ( member(x(Tmp), LCOpt) -> End = [w(Tmp)] ; End = [] ), lst_rw_for_c_call(LReg, End, LCode). codif(foreign_call_c(_, _, LReg, _), LCode) :- lst_rw_for_foreign_c_call(LReg, [], LCode). % instructions which use no temporaries codif(_, []). lst_r_for_call_execute(N, N, []). lst_r_for_call_execute(I, N, [r(I)|L]) :- I1 is I + 1, lst_r_for_call_execute(I1, N, L). lst_rw_for_foreign_c_call([], End, End). lst_rw_for_foreign_c_call([Reg|LReg], End, [r(Reg)|LCode]) :- lst_rw_for_foreign_c_call(LReg, [w(Reg)|End], LCode). lst_rw_for_c_call([], End, End). lst_rw_for_c_call([x(Reg)|LReg], End, [r(Reg)|LCode]) :- !, lst_rw_for_c_call(LReg, [w(Reg)|End], LCode). lst_rw_for_c_call([_|LReg], End, LCode) :- lst_rw_for_c_call(LReg, End, LCode). ��������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/check_boot�����������������������������������������������������������������0000755�0001750�0001750�00000002126�13021324543�015237� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh do_diff() { diff --ignore-space-change -I '^%' -I '^file_name[(]' $1 $2 || \ ( echo "difference encountered: $1 <> $2"; exit 1 ) } copy_files() { for i in $*; do \cp $i ${i}1 done } rm_make() { rm -f $* make >/tmp/make.log 2>&1 || (echo /tmp/make.log ; exit 1) } verify_files() { for i in $*; do # echo checking file $i do_diff $i ${i}1 || exit 1 done } do_all_bootstrap() { copy_files $* || exit 1 rm_make $* || exit 1 verify_files $* || exit 1 } usage() { echo 'usage check_boot -c [FILES] save FILES (.wam) to .wam1)' echo ' check_boot -m [FILES] rm FILES (.wam) and make (rebuild)' echo ' check_boot -v [FILES] verify FILES (.wam) vs .wam1' echo ' check_boot -a [FILES] do all (copy, make, verify)' } case $1 in -c) shift; files=${*:-*.wam}; copy_files $files || exit 1;; -m) shift; files=${*:-*.wam}; rm_make $files || exit 1;; -v) shift; files=${*:-*.wam}; verify_files $files || exit 1;; -a) shift; files=${*:-*.wam}; do_all_bootstrap $files || exit 1;; *) usage; exit 1;; esac exit 0 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/internal.wam���������������������������������������������������������������0000644�0001750�0001750�00000051207�13021356407�015543� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : internal.pl file_name('/home/diaz/GP/src/Pl2Wam/internal.pl'). predicate(user:internal_format/6,74,static,private,monofile,global,[ allocate(5), get_variable(y(0),1), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), put_variable(y(4),1), call(format_head/3), put_value(y(0),0), put_value(y(4),1), put_value(y(1),2), put_value(y(2),3), call(format_body/4), put_unsafe_value(y(4),0), put_integer(0,1), put_value(y(3),2), deallocate, execute(classif_vars/3)]). predicate(user:format_head/3,82,static,private,monofile,global,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_variable(y(3),0), call(get_module_of_cur_pred/1), put_structure((:)/2,0), unify_local_value(y(3)), unify_local_value(y(0)), put_integer(0,1), put_value(y(1),2), put_value(y(2),3), put_void(4), deallocate, execute(format_pred/5)]). predicate(user:format_body/4,89,static,private,monofile,global,[ get_variable(x(5),2), put_value(x(1),2), put_value(x(3),6), put_integer(0,1), put_atom(t,3), put_nil(4), put_void(7), execute(format_body1/8)]). predicate(user:format_body1/8,92,static,private,monofile,global,[ pragma_arity(9), get_current_choice(x(8)), try_me_else(5), switch_on_term(1,4,fail,fail,2), label(1), try_me_else(3), label(2), allocate(8), get_variable(y(1),2), get_variable(y(2),4), get_variable(y(3),6), get_variable(y(4),7), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(8)), put_value(y(1),2), put_variable(y(5),4), put_variable(y(6),6), put_variable(y(7),7), call(format_body1/8), put_value(y(0),0), put_unsafe_value(y(6),1), put_value(y(1),2), put_unsafe_value(y(7),3), put_value(y(2),4), put_unsafe_value(y(5),5), put_value(y(3),6), put_value(y(4),7), deallocate, execute(format_body1/8), label(3), trust_me_else_fail, label(4), get_atom(true,0), get_value(x(5),4), get_value(x(7),3), get_value(x(6),1), cut(x(8)), proceed, label(5), trust_me_else_fail, allocate(6), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(3),6), get_variable(y(4),7), get_list(5), unify_variable(y(2)), unify_local_value(x(4)), put_value(x(3),0), put_value(x(1),2), put_value(y(3),1), call('$format_body1/8_$aux1'/3), put_value(y(0),0), put_value(y(3),1), put_value(y(1),2), put_value(y(2),3), put_variable(y(5),4), call(format_pred/5), put_unsafe_value(y(5),0), put_value(y(4),1), deallocate, execute('$format_body1/8_$aux2'/2)]). predicate(user:'$format_body1/8_$aux2'/2,100,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(t,0), cut(x(2)), get_atom(f,1), proceed, label(1), trust_me_else_fail, get_atom(t,1), proceed]). predicate(user:'$format_body1/8_$aux1'/3,100,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(t,0), cut(x(3)), math_fast_load_value(x(2),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_value(x(1),0), proceed, label(1), trust_me_else_fail, get_value(x(2),1), proceed]). predicate(user:format_pred/5,119,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_structure((:)/2,0), unify_variable(x(6)), unify_variable(x(0)), get_structure(p/4,3), unify_local_value(x(1)), unify_value(x(6)), unify_variable(x(7)), unify_variable(x(6)), cut(x(5)), put_structure(p/4,3), unify_local_value(x(1)), unify_void(1), unify_value(x(7)), unify_value(x(6)), execute(format_pred/5), label(1), trust_me_else_fail, allocate(8), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(6),4), get_structure(p/4,3), unify_local_value(y(1)), unify_variable(x(2)), unify_variable(x(0)), unify_variable(y(5)), get_structure((/)/2,0), unify_variable(y(3)), unify_variable(y(4)), put_value(y(0),0), put_variable(y(7),1), put_value(y(4),3), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(3)]), put_value(y(7),0), put_value(y(4),1), put_value(y(3),3), call(get_owner_module/4), put_value(y(0),1), put_list(2), unify_void(1), unify_variable(x(0)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(1),x(2)]), put_value(y(1),1), put_value(y(2),2), put_value(y(5),3), call(format_arg_lst/4), put_unsafe_value(y(7),0), put_value(y(3),1), put_value(y(4),2), put_value(y(5),3), put_value(y(6),4), deallocate, execute('$format_pred/5_$aux1'/5)]). predicate(user:'$format_pred/5_$aux1'/5,123,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(2), get_variable(y(0),4), get_variable(y(1),5), call('$format_pred/5_$aux2'/4), cut(y(1)), put_value(y(0),0), get_atom(t,0), deallocate, proceed, label(1), trust_me_else_fail, get_atom(f,4), proceed]). predicate(user:'$format_pred/5_$aux2'/4,123,static,private,monofile,local,[ try_me_else(1), get_value(x(1),0), put_value(x(2),1), execute(inline_predicate/2), label(1), trust_me_else_fail, get_value(x(1),0), get_atom('$call_c',0), get_integer(2,2), get_list(3), unify_void(1), unify_list, unify_variable(x(0)), unify_nil, execute(not_dangerous_c_call/1)]). predicate(user:format_arg_lst/4,141,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(3), proceed, label(3), trust_me_else_fail, label(4), allocate(5), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(3), unify_variable(x(3)), unify_variable(y(3)), get_variable(y(4),4), put_value(y(1),1), put_value(y(2),2), call(format_arg/4), cut(y(4)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(format_arg_lst/4)]). predicate(user:format_arg/4,150,static,private,monofile,global,[ try_me_else(1), get_variable(x(4),2), get_variable(x(2),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), put_value(x(4),0), execute(add_var_to_dico/4), label(1), retry_me_else(2), get_variable(x(1),0), put_value(x(3),0), execute(no_internal_transf/2), label(2), retry_me_else(3), get_nil(0), get_atom(nil,3), proceed, label(3), retry_me_else(4), get_structure(atm/1,3), unify_local_value(x(0)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), proceed, label(4), retry_me_else(5), get_structure(int/1,3), unify_local_value(x(0)), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), proceed, label(5), retry_me_else(6), get_structure(flt/1,3), unify_local_value(x(0)), call_c('Pl_Blt_Float',[fast_call,boolean],[x(0)]), proceed, label(6), trust_me_else_fail, get_variable(x(4),0), get_structure(stc/3,3), unify_variable(x(0)), unify_variable(x(5)), unify_variable(x(3)), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(4),x(0),x(5)]), put_list(5), unify_void(1), unify_variable(x(0)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(4),x(5)]), execute(format_arg_lst/4)]). predicate(user:no_internal_transf/2,183,static,private,monofile,global,[ put_atom('$no_internal_tranf$',2), put_integer(1,3), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(2),x(3)]), put_integer(1,2), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(2),x(1),x(0)]), proceed]). predicate(user:add_var_to_dico/4,197,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(4)), get_structure(var/2,3), unify_void(2), get_list(0), unify_variable(x(0)), unify_void(1), get_structure(v/4,0), unify_local_value(x(1)), unify_local_value(x(2)), unify_void(1), unify_local_value(x(3)), proceed, label(1), trust_me_else_fail, switch_on_term(3,fail,fail,2,fail), label(2), try(4), trust(6), label(3), try_me_else(5), label(4), get_variable(x(6),1), get_list(0), unify_variable(x(0)), unify_void(1), get_structure(v/4,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(x(5)), unify_local_value(x(3)), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(6)]), cut(x(4)), get_structure(var/2,3), unify_variable(x(0)), unify_void(1), get_atom(f,5), execute('$add_var_to_dico/4_$aux1'/3), label(5), trust_me_else_fail, label(6), get_list(0), unify_void(1), unify_variable(x(0)), execute(add_var_to_dico/4)]). predicate(user:'$add_var_to_dico/4_$aux1'/3,202,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(2)]), math_fast_load_value(x(2),1), put_integer(1,2), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(1),x(2)]), cut(x(3)), get_structure(y/1,0), unify_void(1), proceed, label(1), trust_me_else_fail, proceed]). predicate(user:classif_vars/3,219,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), cut(x(3)), proceed, label(4), retry_me_else(6), label(5), allocate(3), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure(v/4,0), unify_void(2), unify_variable(x(0)), unify_structure(var/2), unify_variable(x(1)), unify_void(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), cut(x(3)), call('$classif_vars/3_$aux1'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(classif_vars/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_structure(v/4,3), unify_void(3), unify_structure(var/2), unify_variable(x(3)), unify_void(1), get_structure(y/1,3), unify_local_value(x(1)), math_fast_load_value(x(1),1), call_c('Pl_Fct_Fast_Inc',[fast_call,x(1)],[x(1)]), execute(classif_vars/3)]). predicate(user:'$classif_vars/3_$aux1'/2,222,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), get_structure(x/1,1), unify_atom(void), proceed, label(1), trust_me_else_fail, get_structure(x/1,1), unify_void(1), proceed]). predicate(user:inline_predicate/2,241,static,private,monofile,global,[ put_atom(inline,3), put_variable(x(2),4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(3),x(4)]), execute(inline_predicate/3)]). predicate(user:inline_predicate/3,248,static,private,monofile,global,[ switch_on_term(4,1,fail,fail,fail), label(1), switch_on_atom([('$get_cut_level',5), ('$get_current_choice',7), ('$cut',9), ('$soft_cut',11), ((=),13), ('$foreign_call_c',15), (var,17), (nonvar,19), (atom,21), (integer,23), (float,25), (number,27), (atomic,29), (compound,31), (callable,33), (ground,35), (is_list,37), (list,39), (partial_list,41), (list_or_partial_list,43), (fd_var,45), (non_fd_var,47), (generic_var,49), (non_generic_var,51), (functor,53), (arg,55), (compare,57), ((=..),59), ((==),61), ((\==),63), ((@<),65), ((@=<),67), ((@>),69), ((@>=),71), ((is),73), ((=:=),75), ((=\=),77), ((<),79), ((=<),81), ((>),83), ((>=),85), (g_assign,87), (g_assignb,89), (g_link,91), (g_read,93), (g_array_size,95), (g_inc,2), (g_inco,99), (g_dec,3), (g_deco,107), (g_set_bit,113), (g_reset_bit,115), (g_test_set_bit,117), (g_test_reset_bit,119)]), label(2), try(97), retry(101), trust(103), label(3), try(105), retry(109), trust(111), label(4), try_me_else(6), label(5), get_atom('$get_cut_level',0), get_integer(1,1), proceed, label(6), retry_me_else(8), label(7), get_atom('$get_current_choice',0), get_integer(1,1), proceed, label(8), retry_me_else(10), label(9), get_atom('$cut',0), get_integer(1,1), proceed, label(10), retry_me_else(12), label(11), get_atom('$soft_cut',0), get_integer(1,1), proceed, label(12), retry_me_else(14), label(13), get_atom(=,0), get_integer(2,1), proceed, label(14), retry_me_else(16), label(15), get_atom('$foreign_call_c',0), get_integer(1,1), proceed, label(16), retry_me_else(18), label(17), get_atom(var,0), get_integer(1,1), get_atom(t,2), proceed, label(18), retry_me_else(20), label(19), get_atom(nonvar,0), get_integer(1,1), get_atom(t,2), proceed, label(20), retry_me_else(22), label(21), get_atom(atom,0), get_integer(1,1), get_atom(t,2), proceed, label(22), retry_me_else(24), label(23), get_atom(integer,0), get_integer(1,1), get_atom(t,2), proceed, label(24), retry_me_else(26), label(25), get_atom(float,0), get_integer(1,1), get_atom(t,2), proceed, label(26), retry_me_else(28), label(27), get_atom(number,0), get_integer(1,1), get_atom(t,2), proceed, label(28), retry_me_else(30), label(29), get_atom(atomic,0), get_integer(1,1), get_atom(t,2), proceed, label(30), retry_me_else(32), label(31), get_atom(compound,0), get_integer(1,1), get_atom(t,2), proceed, label(32), retry_me_else(34), label(33), get_atom(callable,0), get_integer(1,1), get_atom(t,2), proceed, label(34), retry_me_else(36), label(35), get_atom(ground,0), get_integer(1,1), get_atom(t,2), proceed, label(36), retry_me_else(38), label(37), get_atom(is_list,0), get_integer(1,1), get_atom(t,2), proceed, label(38), retry_me_else(40), label(39), get_atom(list,0), get_integer(1,1), get_atom(t,2), proceed, label(40), retry_me_else(42), label(41), get_atom(partial_list,0), get_integer(1,1), get_atom(t,2), proceed, label(42), retry_me_else(44), label(43), get_atom(list_or_partial_list,0), get_integer(1,1), get_atom(t,2), proceed, label(44), retry_me_else(46), label(45), get_atom(fd_var,0), get_integer(1,1), get_atom(t,2), proceed, label(46), retry_me_else(48), label(47), get_atom(non_fd_var,0), get_integer(1,1), get_atom(t,2), proceed, label(48), retry_me_else(50), label(49), get_atom(generic_var,0), get_integer(1,1), get_atom(t,2), proceed, label(50), retry_me_else(52), label(51), get_atom(non_generic_var,0), get_integer(1,1), get_atom(t,2), proceed, label(52), retry_me_else(54), label(53), get_atom(functor,0), get_integer(3,1), get_atom(t,2), proceed, label(54), retry_me_else(56), label(55), get_atom(arg,0), get_integer(3,1), get_atom(t,2), proceed, label(56), retry_me_else(58), label(57), get_atom(compare,0), get_integer(3,1), get_atom(t,2), proceed, label(58), retry_me_else(60), label(59), get_atom(=..,0), get_integer(2,1), get_atom(t,2), proceed, label(60), retry_me_else(62), label(61), get_atom(==,0), get_integer(2,1), get_atom(t,2), proceed, label(62), retry_me_else(64), label(63), get_atom(\==,0), get_integer(2,1), get_atom(t,2), proceed, label(64), retry_me_else(66), label(65), get_atom(@<,0), get_integer(2,1), get_atom(t,2), proceed, label(66), retry_me_else(68), label(67), get_atom(@=<,0), get_integer(2,1), get_atom(t,2), proceed, label(68), retry_me_else(70), label(69), get_atom(@>,0), get_integer(2,1), get_atom(t,2), proceed, label(70), retry_me_else(72), label(71), get_atom(@>=,0), get_integer(2,1), get_atom(t,2), proceed, label(72), retry_me_else(74), label(73), get_atom(is,0), get_integer(2,1), get_atom(t,2), proceed, label(74), retry_me_else(76), label(75), get_atom(=:=,0), get_integer(2,1), get_atom(t,2), proceed, label(76), retry_me_else(78), label(77), get_atom(=\=,0), get_integer(2,1), get_atom(t,2), proceed, label(78), retry_me_else(80), label(79), get_atom(<,0), get_integer(2,1), get_atom(t,2), proceed, label(80), retry_me_else(82), label(81), get_atom(=<,0), get_integer(2,1), get_atom(t,2), proceed, label(82), retry_me_else(84), label(83), get_atom(>,0), get_integer(2,1), get_atom(t,2), proceed, label(84), retry_me_else(86), label(85), get_atom(>=,0), get_integer(2,1), get_atom(t,2), proceed, label(86), retry_me_else(88), label(87), get_atom(g_assign,0), get_integer(2,1), get_atom(t,2), proceed, label(88), retry_me_else(90), label(89), get_atom(g_assignb,0), get_integer(2,1), get_atom(t,2), proceed, label(90), retry_me_else(92), label(91), get_atom(g_link,0), get_integer(2,1), get_atom(t,2), proceed, label(92), retry_me_else(94), label(93), get_atom(g_read,0), get_integer(2,1), get_atom(t,2), proceed, label(94), retry_me_else(96), label(95), get_atom(g_array_size,0), get_integer(2,1), get_atom(t,2), proceed, label(96), retry_me_else(98), label(97), get_atom(g_inc,0), get_integer(1,1), get_atom(t,2), proceed, label(98), retry_me_else(100), label(99), get_atom(g_inco,0), get_integer(2,1), get_atom(t,2), proceed, label(100), retry_me_else(102), label(101), get_atom(g_inc,0), get_integer(2,1), get_atom(t,2), proceed, label(102), retry_me_else(104), label(103), get_atom(g_inc,0), get_integer(3,1), get_atom(t,2), proceed, label(104), retry_me_else(106), label(105), get_atom(g_dec,0), get_integer(1,1), get_atom(t,2), proceed, label(106), retry_me_else(108), label(107), get_atom(g_deco,0), get_integer(2,1), get_atom(t,2), proceed, label(108), retry_me_else(110), label(109), get_atom(g_dec,0), get_integer(2,1), get_atom(t,2), proceed, label(110), retry_me_else(112), label(111), get_atom(g_dec,0), get_integer(3,1), get_atom(t,2), proceed, label(112), retry_me_else(114), label(113), get_atom(g_set_bit,0), get_integer(2,1), get_atom(t,2), proceed, label(114), retry_me_else(116), label(115), get_atom(g_reset_bit,0), get_integer(2,1), get_atom(t,2), proceed, label(116), retry_me_else(118), label(117), get_atom(g_test_set_bit,0), get_integer(2,1), get_atom(t,2), proceed, label(118), trust_me_else_fail, label(119), get_atom(g_test_reset_bit,0), get_integer(2,1), get_atom(t,2), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/reg_alloc.wam��������������������������������������������������������������0000644�0001750�0001750�00000102435�13021356407�015656� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : reg_alloc.pl file_name('/home/diaz/GP/src/Pl2Wam/reg_alloc.pl'). predicate(user:allocate_registers/1,98,static,private,monofile,global,[ put_void(1), execute(allocate_registers/2)]). predicate(user:allocate_registers/2,102,static,private,monofile,global,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), put_atom(reg_opt,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_value(y(0),1), put_variable(y(2),2), call('$allocate_registers/2_$aux1'/3), put_value(y(0),0), put_value(y(2),1), put_void(2), put_variable(y(3),3), call(create_lst_tmp/4), put_unsafe_value(y(3),0), put_value(y(1),1), deallocate, execute(assign_lst_tmp/2)]). predicate(user:'$allocate_registers/2_$aux1'/3,102,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), math_fast_load_value(x(0),0), put_integer(0,4), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(4)]), cut(x(3)), put_value(x(1),0), put_nil(1), execute(aliases/3), label(1), trust_me_else_fail, proceed]). predicate(user:aliases/3,116,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(2), unify_local_value(x(1)), unify_variable(y(1)), get_variable(y(2),3), put_value(x(1),2), put_variable(y(3),1), call('$aliases/3_$aux1'/3), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), put_value(y(1),2), deallocate, execute(aliases/3)]). predicate(user:'$aliases/3_$aux1'/3,118,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),1), get_variable(y(1),3), call(alias_stop_instruction/1), cut(y(1)), put_value(y(0),0), get_nil(0), deallocate, proceed, label(1), trust_me_else_fail, allocate(3), get_variable(y(0),1), get_variable(y(1),2), put_variable(y(2),1), call(codification/2), put_unsafe_value(y(2),0), put_value(y(1),1), put_value(y(0),2), deallocate, execute(aliases1/3)]). predicate(user:aliases1/3,127,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(1),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(2),3), put_value(x(1),2), put_variable(y(3),1), call('$aliases1/3_$aux1'/3), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), put_value(y(1),2), deallocate, execute(aliases1/3)]). predicate(user:'$aliases1/3_$aux1'/3,129,static,private,monofile,local,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(r/1,3),(w/1,5),(c/2,7)]), label(2), try_me_else(4), label(3), get_structure(r/1,0), unify_void(1), get_value(x(2),1), proceed, label(4), retry_me_else(6), label(5), get_variable(x(3),2), get_variable(x(2),1), get_structure(w/1,0), unify_variable(x(1)), put_value(x(3),0), execute(remove_aliases_of/3), label(6), trust_me_else_fail, label(7), allocate(4), get_variable(y(0),1), get_structure(c/2,0), unify_variable(y(1)), unify_variable(y(2)), put_value(x(2),0), put_value(y(2),1), put_variable(y(3),2), call(remove_aliases_of/3), put_unsafe_value(y(3),0), put_value(y(1),1), put_value(y(2),2), put_value(y(0),3), deallocate, execute(add_alias/4)]). predicate(user:add_alias/4,143,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_list(3), unify_variable(x(0)), unify_nil, get_list(0), unify_local_value(x(1)), unify_list, unify_local_value(x(2)), unify_nil, proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(0)), unify_variable(x(5)), get_list(3), unify_variable(x(3)), unify_variable(x(4)), execute('$add_alias/4_$aux1'/6)]). predicate(user:'$add_alias/4_$aux1'/6,145,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(6), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_variable(y(5),6), put_value(y(0),0), call(set_elt/2), cut(y(5)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), call(set_add/3), put_value(y(3),0), get_value(y(4),0), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(0),3), put_value(x(5),0), put_value(x(4),3), execute(add_alias/4)]). predicate(user:find_aliases_of/3,156,static,private,monofile,global,[ get_list(0), unify_variable(x(0)), unify_variable(x(3)), execute('$find_aliases_of/3_$aux1'/4)]). predicate(user:'$find_aliases_of/3_$aux1'/4,156,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(1), get_variable(y(0),4), call(set_delete/3), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_value(x(3),0), execute(find_aliases_of/3)]). predicate(user:remove_aliases_of/3,165,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(2), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(0)), unify_variable(x(3)), execute('$remove_aliases_of/3_$aux1'/4)]). predicate(user:'$remove_aliases_of/3_$aux1'/4,167,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(4), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), put_variable(y(3),2), call(set_delete/3), cut(y(2)), put_unsafe_value(y(3),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute('$remove_aliases_of/3_$aux2'/3), label(1), trust_me_else_fail, get_list(2), unify_local_value(x(0)), unify_variable(x(2)), put_value(x(3),0), execute(remove_aliases_of/3)]). predicate(user:'$remove_aliases_of/3_$aux2'/3,167,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(3), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), call('$remove_aliases_of/3_$aux3'/1), cut(y(2)), put_value(y(0),0), get_value(y(1),0), deallocate, proceed, label(1), trust_me_else_fail, get_list(1), unify_local_value(x(0)), unify_local_value(x(2)), proceed]). predicate(user:'$remove_aliases_of/3_$aux3'/1,167,static,private,monofile,local,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_void(1), unify_nil, proceed]). predicate(user:create_lst_tmp/4,184,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), proceed, label(3), trust_me_else_fail, label(4), allocate(8), get_variable(y(2),2), get_variable(y(3),3), get_list(0), unify_variable(y(0)), unify_variable(x(0)), get_list(1), unify_variable(y(1)), unify_variable(x(1)), get_variable(y(4),4), put_variable(y(5),2), put_variable(y(6),3), call(create_lst_tmp/4), put_value(y(0),0), put_variable(y(7),1), call(codification/2), cut(y(4)), put_unsafe_value(y(7),0), put_value(y(1),1), put_unsafe_value(y(5),2), put_value(y(2),3), put_unsafe_value(y(6),4), put_value(y(3),5), deallocate, execute(handle_lst_code/6)]). predicate(user:handle_lst_code/6,194,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(5),4), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(6), get_variable(y(1),1), get_variable(y(2),3), get_variable(y(3),5), get_list(0), unify_variable(y(0)), unify_variable(x(0)), put_value(y(1),1), put_variable(y(4),3), put_variable(y(5),5), call(handle_lst_code/6), put_value(y(0),0), put_value(y(1),1), put_nil(2), put_unsafe_value(y(4),3), put_value(y(2),4), put_unsafe_value(y(5),5), put_value(y(3),6), deallocate, execute(handle_one_code/7)]). predicate(user:handle_one_code/7,203,static,private,monofile,global,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(r/1,3),(w/1,5),(c/2,7)]), label(2), try_me_else(4), label(3), get_variable(x(7),6), get_variable(x(8),3), get_variable(x(3),2), get_variable(x(6),1), get_structure(r/1,0), unify_variable(x(1)), put_value(x(8),0), put_value(x(4),2), put_value(x(5),4), put_value(x(7),5), execute('$handle_one_code/7_$aux1'/7), label(4), retry_me_else(6), label(5), get_variable(x(7),6), get_variable(x(8),3), get_variable(x(3),2), get_variable(x(6),1), get_structure(w/1,0), unify_variable(x(1)), put_value(x(8),0), put_value(x(4),2), put_value(x(5),4), put_value(x(7),5), execute('$handle_one_code/7_$aux2'/7), label(6), trust_me_else_fail, label(7), allocate(7), get_structure(c/2,0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),1), get_variable(y(3),4), get_variable(y(4),6), put_structure(w/1,0), unify_value(y(1)), put_value(y(2),1), put_list(2), unify_value(y(0)), unify_nil, put_variable(y(5),4), put_variable(y(6),6), call(handle_one_code/7), put_structure(r/1,0), unify_value(y(0)), put_value(y(2),1), put_list(2), unify_value(y(1)), unify_nil, put_unsafe_value(y(5),3), put_value(y(3),4), put_unsafe_value(y(6),5), put_value(y(4),6), deallocate, execute(handle_one_code/7)]). predicate(user:'$handle_one_code/7_$aux2'/7,220,static,private,monofile,local,[ pragma_arity(8), get_current_choice(x(7)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), get_variable(y(4),7), put_value(y(0),1), call(set_delete/3), cut(y(4)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$handle_one_code/7_$aux3'/4), label(1), trust_me_else_fail, get_value(x(0),2), put_value(x(1),0), put_value(x(2),1), put_value(x(6),2), execute('$handle_one_code/7_$aux4'/6)]). predicate(user:'$handle_one_code/7_$aux4'/6,220,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(7), get_variable(y(0),0), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), put_value(y(0),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(6)), put_value(y(0),0), put_variable(y(4),3), call(constraints/4), put_value(y(1),0), put_value(y(4),1), put_variable(y(5),2), call('$handle_one_code/7_$aux5'/3), put_value(y(5),0), put_list(1), unify_local_value(y(0)), unify_nil, put_value(y(2),2), put_variable(y(6),3), call(make_imposs/4), put_unsafe_value(y(6),0), put_value(y(0),1), put_unsafe_value(y(5),2), put_value(y(1),3), put_value(y(3),4), deallocate, execute(update_tmp/5), label(1), trust_me_else_fail, get_value(x(4),5), proceed]). predicate(user:'$handle_one_code/7_$aux5'/3,220,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_variable(x(4),1), get_variable(x(1),0), put_nil(0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), cut(x(3)), put_value(x(4),0), execute(set_diff/3), label(1), trust_me_else_fail, get_value(x(1),2), proceed]). predicate(user:'$handle_one_code/7_$aux3'/4,220,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_variable(x(5),3), get_variable(x(3),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), put_nil(0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(3),x(0)]), cut(x(4)), put_value(x(2),0), put_value(x(5),4), put_nil(2), execute(update_tmp/5), label(1), trust_me_else_fail, get_value(x(2),3), proceed]). predicate(user:'$handle_one_code/7_$aux1'/7,203,static,private,monofile,local,[ pragma_arity(8), get_current_choice(x(7)), try_me_else(1), allocate(7), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),7), put_value(y(0),0), put_value(y(1),1), call(set_elt/2), cut(y(6)), put_value(y(2),0), get_value(y(0),0), put_value(y(1),0), put_value(y(3),1), put_value(y(4),2), put_value(y(5),3), deallocate, execute('$handle_one_code/7_$aux6'/4), label(1), trust_me_else_fail, allocate(6), get_variable(y(0),1), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), get_list(2), unify_local_value(y(0)), unify_local_value(x(0)), put_value(x(0),1), put_value(x(6),2), put_value(y(0),0), put_variable(y(4),3), call(constraints/4), put_value(y(4),0), put_list(1), unify_local_value(y(0)), unify_nil, put_value(y(2),2), put_variable(y(5),3), call(make_imposs/4), put_value(y(0),0), put_unsafe_value(y(5),1), put_unsafe_value(y(4),2), put_value(y(1),3), put_value(y(3),4), deallocate, execute('$handle_one_code/7_$aux7'/5)]). predicate(user:'$handle_one_code/7_$aux7'/5,203,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_variable(x(6),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), cut(x(5)), put_value(x(6),0), execute(update_tmp/5), label(1), trust_me_else_fail, get_value(x(1),4), proceed]). predicate(user:'$handle_one_code/7_$aux6'/4,203,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_variable(x(5),3), get_variable(x(3),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), put_nil(0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(3),x(0)]), cut(x(4)), put_value(x(2),0), put_value(x(5),4), put_nil(2), execute(update_tmp/5), label(1), trust_me_else_fail, get_value(x(2),3), proceed]). predicate(user:constraints/4,247,static,private,monofile,global,[ get_variable(x(4),2), get_variable(x(2),1), get_variable(x(1),0), put_value(x(4),0), execute('$constraints/4_$aux1'/4)]). predicate(user:'$constraints/4_$aux1'/4,247,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(4), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), put_atom(reg_opt,2), put_integer(2,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), put_variable(y(3),2), call(find_aliases_of/3), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), put_value(y(1),2), deallocate, execute(set_diff/3), label(1), trust_me_else_fail, get_value(x(2),3), proceed]). predicate(user:update_tmp/5,257,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_list(4), unify_variable(x(0)), unify_nil, get_structure(tmp/3,0), unify_local_value(x(1)), unify_local_value(x(2)), unify_local_value(x(3)), proceed, label(3), trust_me_else_fail, label(4), get_variable(x(10),3), get_variable(x(11),1), get_list(0), unify_variable(x(9)), unify_variable(x(8)), get_list(4), unify_variable(x(6)), unify_variable(x(7)), get_structure(tmp/3,9), unify_variable(x(1)), unify_variable(x(3)), unify_variable(x(5)), put_value(x(11),0), put_value(x(10),4), execute('$update_tmp/5_$aux1'/10)]). predicate(user:'$update_tmp/5_$aux1'/10,259,static,private,monofile,local,[ pragma_arity(11), get_current_choice(x(10)), try_me_else(1), allocate(8), get_variable(y(0),0), get_variable(y(1),4), get_variable(y(2),5), get_variable(y(3),6), get_variable(y(4),7), get_variable(y(5),8), put_value(y(0),0), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), cut(x(10)), put_value(x(2),0), put_value(x(3),1), put_variable(y(6),2), call(set_union/3), put_value(y(1),0), put_value(y(2),1), put_variable(y(7),2), call(set_union/3), put_value(y(3),0), get_structure(tmp/3,0), unify_local_value(y(0)), unify_local_value(y(6)), unify_local_value(y(7)), put_value(y(4),0), get_value(y(5),0), deallocate, proceed, label(1), trust_me_else_fail, get_variable(x(1),0), get_value(x(9),6), put_value(x(8),0), put_value(x(4),3), put_value(x(7),4), execute(update_tmp/5)]). predicate(user:remove_tmp/5,273,static,private,monofile,global,[ get_variable(x(6),4), get_variable(x(4),3), get_variable(x(9),1), get_list(0), unify_variable(x(8)), unify_variable(x(7)), get_structure(tmp/3,8), unify_variable(x(1)), unify_variable(x(3)), unify_variable(x(5)), put_value(x(9),0), execute('$remove_tmp/5_$aux1'/9)]). predicate(user:'$remove_tmp/5_$aux1'/9,273,static,private,monofile,local,[ pragma_arity(10), get_current_choice(x(9)), try_me_else(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), cut(x(9)), get_value(x(3),2), get_value(x(5),4), get_value(x(7),6), proceed, label(1), trust_me_else_fail, get_variable(x(3),4), get_variable(x(1),0), get_list(6), unify_local_value(x(8)), unify_variable(x(4)), put_value(x(7),0), execute(remove_tmp/5)]). predicate(user:make_imposs/4,287,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(1),1), get_variable(y(2),3), get_list(0), unify_variable(x(0)), unify_variable(y(0)), put_value(x(2),1), put_value(y(1),2), put_variable(y(3),3), call('$make_imposs/4_$aux1'/4), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_value(y(2),3), deallocate, execute(make_imposs/4)]). predicate(user:'$make_imposs/4_$aux1'/4,289,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_variable(x(5),1), get_variable(x(1),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), cut(x(4)), put_value(x(5),0), put_value(x(3),4), put_nil(3), execute(update_tmp/5), label(1), trust_me_else_fail, get_value(x(1),3), proceed]). predicate(user:assign_lst_tmp/2,301,static,private,monofile,global,[ allocate(2), get_variable(y(0),1), get_variable(x(1),0), put_atom(reg_opt,2), put_variable(x(0),3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), put_variable(y(1),2), call('$assign_lst_tmp/2_$aux1'/3), put_unsafe_value(y(1),0), put_integer(-1,1), put_value(y(0),2), deallocate, execute(assign_values/3)]). predicate(user:'$assign_lst_tmp/2_$aux1'/3,301,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_integer(2,0), cut(x(3)), put_value(x(1),0), put_value(x(2),1), execute(assign_wishes/2), label(1), trust_me_else_fail, get_variable(x(3),1), get_variable(x(1),0), put_value(x(3),0), execute(no_wish/3)]). predicate(user:assign_wishes/2,312,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), proceed, label(3), trust_me_else_fail, label(4), allocate(6), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(x(2)), get_structure(tmp/3,0), unify_variable(y(0)), unify_variable(x(1)), unify_variable(x(0)), put_value(y(0),3), put_variable(y(2),4), put_variable(y(3),5), put_variable(y(4),6), call(collapse_tmps/7), put_value(y(0),0), put_value(y(3),1), put_value(y(2),2), call(try_a_whish/3), put_value(y(0),0), put_value(y(1),1), put_value(y(3),2), put_variable(y(5),3), call('$assign_wishes/2_$aux1'/4), put_unsafe_value(y(4),0), put_unsafe_value(y(5),1), deallocate, execute(assign_wishes/2)]). predicate(user:'$assign_wishes/2_$aux1'/4,314,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(4)), get_list(1), unify_variable(x(1)), unify_local_value(x(3)), get_structure(tmp/2,1), unify_local_value(x(0)), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_value(x(3),1), proceed]). predicate(user:collapse_tmps/7,326,static,private,monofile,global,[ pragma_arity(8), get_current_choice(x(7)), switch_on_term(2,3,fail,1,fail), label(1), try(5), retry(7), trust(9), label(2), try_me_else(4), label(3), get_nil(0), get_nil(4), get_value(x(6),2), get_value(x(5),1), proceed, label(4), retry_me_else(6), label(5), allocate(8), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(7),7), put_value(y(3),1), put_value(y(1),2), call('$collapse_tmps/7_$aux1'/3), cut(y(7)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), put_value(y(6),6), deallocate, execute(collapse_tmps/7), label(6), retry_me_else(8), label(7), get_list(0), unify_variable(x(8)), unify_variable(x(0)), get_list(4), unify_value(x(8)), unify_variable(x(4)), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(8)]), cut(x(7)), execute(collapse_tmps/7), label(8), trust_me_else_fail, label(9), allocate(12), get_list(0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),1), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), put_value(x(2),0), put_value(y(0),1), put_variable(y(7),2), put_variable(y(8),3), put_variable(y(9),4), call(remove_tmp/5), put_value(y(2),0), put_value(y(7),1), put_variable(y(10),2), call(set_union/3), put_value(y(1),0), put_value(y(8),1), put_variable(y(11),2), call(set_union/3), put_value(y(3),0), get_value(y(0),0), put_unsafe_value(y(11),0), put_unsafe_value(y(10),1), put_unsafe_value(y(9),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), put_value(y(6),6), deallocate, execute(collapse_tmps/7)]). predicate(user:'$collapse_tmps/7_$aux1'/3,328,static,private,monofile,local,[ try_me_else(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, get_variable(x(1),0), put_value(x(2),0), execute(set_elt/2)]). predicate(user:try_a_whish/3,348,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(x(4),2), get_variable(y(0),3), put_list(2), unify_local_value(x(0)), unify_void(1), put_value(x(4),0), call(set_diff/3), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, proceed]). predicate(user:no_wish/3,356,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(2), proceed, label(3), trust_me_else_fail, label(4), allocate(3), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure(tmp/3,0), unify_variable(x(3)), unify_variable(x(1)), unify_variable(x(0)), get_list(2), unify_variable(x(2)), unify_variable(y(2)), get_structure(tmp/2,2), unify_value(x(3)), unify_variable(x(3)), put_value(x(0),2), put_value(y(1),0), call('$no_wish/3_$aux1'/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(no_wish/3)]). predicate(user:'$no_wish/3_$aux1'/4,358,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_integer(0,0), cut(x(4)), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), execute(set_union/3), label(1), trust_me_else_fail, get_value(x(1),3), proceed]). predicate(user:assign_values/3,368,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), proceed, label(3), trust_me_else_fail, label(4), allocate(6), get_variable(y(2),1), get_variable(y(3),2), get_list(0), unify_variable(x(0)), unify_variable(y(1)), get_structure(tmp/2,0), unify_variable(y(0)), unify_variable(x(0)), put_variable(y(4),1), call(sort/2), put_value(y(4),0), put_integer(0,1), put_value(y(0),2), call(find_hole/3), put_value(y(0),0), put_value(y(2),1), put_variable(y(5),2), call('$assign_values/3_$aux1'/3), put_value(y(1),0), put_unsafe_value(y(5),1), put_value(y(3),2), deallocate, execute(assign_values/3)]). predicate(user:'$assign_values/3_$aux1'/3,370,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), math_fast_load_value(x(0),4), math_fast_load_value(x(1),1), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(4),x(1)]), cut(x(3)), get_value(x(0),2), proceed, label(1), trust_me_else_fail, get_value(x(1),2), proceed]). predicate(user:find_hole/3,382,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), proceed, label(4), retry_me_else(6), label(5), get_list(0), unify_variable(x(4)), unify_variable(x(0)), call_c('Pl_Blt_Var',[fast_call,boolean],[x(4)]), cut(x(3)), execute(find_hole/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(0)), unify_variable(x(3)), execute('$find_hole/3_$aux1'/4)]). predicate(user:'$find_hole/3_$aux1'/4,388,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), math_fast_load_value(x(0),0), math_fast_load_value(x(1),3), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(3)]), cut(x(4)), get_value(x(1),2), proceed, label(1), trust_me_else_fail, allocate(3), get_variable(y(0),2), get_variable(y(1),3), put_variable(y(2),2), call('$find_hole/3_$aux2'/3), put_value(y(1),0), put_unsafe_value(y(2),1), put_value(y(0),2), deallocate, execute(find_hole/3)]). predicate(user:'$find_hole/3_$aux2'/3,388,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), cut(x(3)), math_fast_load_value(x(1),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_value(x(2),0), proceed, label(1), trust_me_else_fail, get_value(x(1),2), proceed]). predicate(user:set_add/3,403,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_list(2), unify_local_value(x(1)), unify_nil, proceed, label(4), retry_me_else(6), label(5), get_list(0), unify_variable(x(0)), unify_variable(x(4)), get_list(2), unify_value(x(0)), unify_value(x(4)), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(1),x(0)]), cut(x(3)), proceed, label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_value(x(3)), unify_variable(x(2)), execute(set_add/3)]). predicate(user:set_delete/3,414,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), get_list(0), unify_variable(x(0)), unify_local_value(x(2)), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(1),x(0)]), cut(x(3)), proceed, label(4), trust_me_else_fail, label(5), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_value(x(3)), unify_variable(x(2)), execute(set_delete/3)]). predicate(user:set_elt/2,424,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), get_list(0), unify_variable(x(0)), unify_void(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(1),x(0)]), cut(x(2)), proceed, label(4), trust_me_else_fail, label(5), get_list(0), unify_void(1), unify_variable(x(0)), execute(set_elt/2)]). predicate(user:set_inter/3,433,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_nil(2), proceed, label(4), retry_me_else(6), label(5), allocate(4), get_variable(y(1),1), get_list(0), unify_variable(x(1)), unify_variable(y(0)), get_list(2), unify_value(x(1)), unify_variable(y(2)), get_variable(y(3),3), put_value(y(1),0), call(set_elt/2), cut(y(3)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(set_inter/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_void(1), unify_variable(x(0)), execute(set_inter/3)]). predicate(user:set_union/3,445,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), proceed, label(4), retry_me_else(6), label(5), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(1)), unify_variable(y(0)), get_variable(y(3),3), put_value(y(1),0), call(set_elt/2), cut(y(3)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(set_union/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_value(x(3)), unify_variable(x(2)), execute(set_union/3)]). predicate(user:set_diff/3,457,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(2), proceed, label(3), trust_me_else_fail, label(4), allocate(3), get_variable(y(1),1), get_list(0), unify_variable(x(1)), unify_variable(y(0)), put_value(y(1),0), put_variable(y(2),3), call('$set_diff/3_$aux1'/4), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(2),2), deallocate, execute(set_diff/3)]). predicate(user:'$set_diff/3_$aux1'/4,459,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(3), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), call(set_elt/2), cut(y(2)), put_value(y(0),0), get_value(y(1),0), deallocate, proceed, label(1), trust_me_else_fail, get_list(2), unify_local_value(x(1)), unify_local_value(x(3)), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/swilib.pl������������������������������������������������������������������0000644�0001750�0001750�00000001537�13021324543�015044� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� prolog_name('SWI Prolog'). prolog_version(X) :- current_prolog_flag(version, V), number_atom(V, X). prolog_date(X) :- current_prolog_flag(compiled_at, X). prolog_copyright(''). callable(X) :- atom(X), !. callable(X) :- compound(X). /* g_vars */ :- dynamic(gvar / 2). g_assign(Var, Value) :- ( retract(gvar(Var, _)) ; true ), !, asserta(gvar(Var, Value)). g_read(Var, Value) :- ( gvar(Var, Value1) ; Value1 = 0 ), !, Value = Value1. argument_list(LArgs) :- unix(argv([_|L])), delete_flags(L, LArgs), !. delete_flags([], []). delete_flags(['-x', _|L], L1) :- delete_flags(L, L1). delete_flags(['-t', _|L], L1) :- delete_flags(L, L1). delete_flags(['-g', _|L], L1) :- delete_flags(L, L1). delete_flags([--|L], L). go_other :- argument_list(L), go_other1(L). go_other1([]) :- !. go_other1(L) :- pl2wam(L), halt. �����������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/compat.pl������������������������������������������������������������������0000644�0001750�0001750�00000004601�13021324543�015031� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� :- op(0, fx, dynamic). :- op(0, fx, discontiguous). :- op(0, fx, multifile). prolog_file_name(PlFile, PlFile1) :- decompose_file_name(PlFile, _Dir, _Prefix, Suffix), ( ( PlFile = user ; Suffix \== '' ) -> PlFile1 = PlFile ; atom_concat(PlFile, '.pl', PlFile1) ). last_read_start_line_column(Line, Col) :- g_read('$last_line', Line), g_read('$last_col', Col). stream_line_column(Stream, Line, Col) :- line_count(Stream, Count), line_position(Stream, Pos), Line is Count + 1, Col is Pos + 1, g_assign('$last_line', Line), g_assign('$last_col', Col). date_time(dt(0, 0, 0, 0, 0, 0)). numbervars(T) :- numbervars(T, 0, _). decompose_file_name(Path, Dir, Prefix, Suffix) :- atom_length(Path, L), Before is L - 1, find_dir_and_file_name(Path, Before, Dir, FileName), ( sub_atom(FileName, LgPrefix, 1, _, '.') -> sub_atom(FileName, 0, LgPrefix, LgSuffix, Prefix), sub_atom(FileName, LgPrefix, LgSuffix, 0, Suffix) ; Prefix = FileName, Suffix = '' ), !. find_dir_and_file_name(Path, Before, '', Path) :- Before < 0, !. find_dir_and_file_name(Path, Before, Dir, FileName) :- sub_atom(Path, Before, 1, After, /), Before1 is Before + 1, sub_atom(Path, 0, Before1, _, Dir), sub_atom(Path, _, After, 0, FileName), !. find_dir_and_file_name(Path, Before, Dir, FileName) :- Before1 is Before - 1, find_dir_and_file_name(Path, Before1, Dir, FileName). number_atom(N, A) :- ( number(N) -> number_chars(N, LCode), atom_chars(A, LCode) ; atom_chars(A, LCode), number_chars(N, LCode) ). '$catch'(Goal, Catcher, Recovery, _, _, _) :- catch(Goal, Catcher, Recovery). '$aux_name'(Name) :- sub_atom(Name, _, 5, _, '_$aux'), !. '$make_aux_name'(Pred, N, Aux, AuxName) :- ( sub_atom(Pred, LgBefore, 5, _, '_$aux') -> sub_atom(Pred, 0, LgBefore, _, Pred1) ; number_atom(N, AN), atom_concat($, Pred, Pred2), atom_concat(Pred2, /, Pred3), atom_concat(Pred3, AN, Pred1) ), number_atom(Aux, ANo), atom_concat('_$aux', ANo, AAux), atom_concat(Pred1, AAux, AuxName). '$pred_without_aux'(Func, Arity, Func1, Arity1) :- ( sub_atom(Func, LgBefore, 5, _, '_$aux') -> sub_atom(Func, B, 1, _, /), L is B - 1, sub_atom(Func, 1, L, _, Func1), B1 is B + 1, A is LgBefore - B - 1, sub_atom(Func, B1, A, _, SA1), number_atom(Arity1, SA1), ! ; Func1 = Func, Arity1 = Arity ). �������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/whole.pl�������������������������������������������������������������������0000644�0001750�0001750�00000000367�13021324543�014671� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� :- include(read_file). :- include(bip_list). :- include(syn_sugar). :- include(internal). :- include(code_gen). :- include(reg_alloc). :- include(inst_codif). :- include(first_arg). :- include(indexing). :- include(wam_emit). :- include(pl2wam). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/reg_alloc.pl���������������������������������������������������������������0000644�0001750�0001750�00000035023�13021324543�015477� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : reg_alloc.pl * * Descr.: pass 4: register allocation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * The main predicate is: * * allocate_registers(LInstW) ou allocate_registers(LInstW,MaxRegUsed): * * where LInstW is a list of instructions. * * and MaxRegUsed is an integer corresponding to the greatest register * * used (-1 if none or n>=0 if reg0...regMaxRegUsed are used). * * * * Two predicates must be provided in addition to the allocater: * * * * codification(InstW, LCode): * * defines the action of InstW on the registers as a list LCode of codes* * c(R1, R2) (copy R1 into R2), r(R) (read R) or w(R) (write R). * * * * alias_stop_instruction(InstW): * * true if InstW stop aliasing propagation. * * * * Terminology: * * Arg: Arg is an argument iff integer(Arg) * * Tmp: Tmp is a temporary iff var(Tmp) * * Reg: Reg is a register if it is either an argument or a temporary. * * * * This allocation proceeds in 3 steps: * * * * 1) computing aliases (i.e. list of same values at entry of each inst): * * LAlias is a list of aliases (one for each instruction) * * LAlias = [Alias,...] * * The aliases (Alias) are represented as a set of same values (LSame) * * Alias = [LSame,...]. * * each LSame is a set of Regs (integers or variables) * * eg Alias = [[1,2,X,Y],[3,Z,4]] means 1,2,X,Y are aliased, 3,Z,4 also* * * * 2) computing the list of temporaries LTmp=[tmp(Tmp, Imposs, Wish),...] * * where Imposs is a set of impossible values and Wish a set of wanted * * values (to give rise to useless copy instructions). * * The code is traversed in reverse order, computing at each time the * * set of Regs in life (InLife) (see PhD Thesis of Mats Carlsson). * * * * 3) Each Tmp in LTmp is assigned w.r.t. to Wish and Imposs in 2 steps: * * * * a) from [tmp(Tmp, Imposs, Wish)|LTmp]: * * * * while there exists Tmpj in Wish and not in Imposs: * * let tmp(Tmpj, Impossj, Wishj) be the associated record in LTmp* * Imposs := Imposs + Impossj and Wish := Wish + Wishj, * * LTmp := LTmp-tmp(Tmpj, Impossj, Wishj) (remove Tmpj from LTmp)* * Tmpj = Tmp (unify them) * * * * At the end of the loop: * * if there exists an integer k in Wish-Imposs then (see NB below) * * Tmp = k else replace tmp(Tmp, Imposs, Wish) in LTmp * * * * b) for each Tmp remaining in LTmp assign a value w.r.t to Imposs * * by chosing the first integer not present in Imposs (after sort) * * * * NB: it seems, from the construction, that, in Wish, only remains * * possible values so the compl(Wish, Imposs, AssignOK) would be useless, * * but I have to check this in depth. * *-------------------------------------------------------------------------*/ allocate_registers(LInstW) :- allocate_registers(LInstW, _). allocate_registers(LInstW, MaxRegUsed) :- g_read(reg_opt, OptReg), ( OptReg > 0 -> aliases(LInstW, [], LAlias) ; true ), create_lst_tmp(LInstW, LAlias, _, LTmp), assign_lst_tmp(LTmp, MaxRegUsed). % Aliasing information creation aliases([], _, []). aliases([InstW|LInstW], Alias, [Alias|LAlias]) :- ( alias_stop_instruction(InstW) -> Alias1 = [] ; codification(InstW, LCode), aliases1(LCode, Alias, Alias1) ), !, aliases(LInstW, Alias1, LAlias). aliases1([], Alias, Alias). aliases1([Code|LCode], Alias, Alias3) :- ( Code = r(Reg), Alias2 = Alias ; Code = w(Reg), remove_aliases_of(Alias, Reg, Alias2) ; Code = c(Reg, Reg1), remove_aliases_of(Alias, Reg1, Alias1), add_alias(Alias1, Reg, Reg1, Alias2) ), !, aliases1(LCode, Alias2, Alias3). add_alias([], Reg, Reg1, [[Reg, Reg1]]). add_alias([LSame|Alias], Reg, Reg1, [LSame1|Alias1]) :- ( set_elt(LSame, Reg) -> set_add(LSame, Reg1, LSame1), Alias1 = Alias ; LSame1 = LSame, add_alias(Alias, Reg, Reg1, Alias1) ). find_aliases_of([LSame|Alias], Reg, LSame1) :- ( set_delete(LSame, Reg, LSame1) -> true ; find_aliases_of(Alias, Reg, LSame1) ). remove_aliases_of([], _, []). remove_aliases_of([LSame|Alias], Reg, Alias1) :- ( set_delete(LSame, Reg, LSame1) -> ( ( LSame1 = [] ; LSame1 = [_] ) -> Alias1 = Alias ; Alias1 = [LSame1|Alias] ) ; Alias1 = [LSame|Alias2], remove_aliases_of(Alias, Reg, Alias2) ). % Temporaries dictionnary creation (lifetime analysis) create_lst_tmp([], [], [], []). create_lst_tmp([InstW|LInstW], [Alias|LAlias], InLife1, LTmp1) :- create_lst_tmp(LInstW, LAlias, InLife, LTmp), codification(InstW, LCode), !, handle_lst_code(LCode, Alias, InLife, InLife1, LTmp, LTmp1). handle_lst_code([], _, InLife, InLife, LTmp, LTmp). handle_lst_code([Code|LCode], Alias, InLife, InLife2, LTmp, LTmp2) :- handle_lst_code(LCode, Alias, InLife, InLife1, LTmp, LTmp1), handle_one_code(Code, Alias, [], InLife1, InLife2, LTmp1, LTmp2). handle_one_code(r(Reg), Alias, Wish, InLife, InLife1, LTmp, LTmp2) :- ( set_elt(InLife, Reg) -> InLife1 = InLife, ( var(Reg), Wish \== [] -> update_tmp(LTmp, Reg, [], Wish, LTmp2) ; LTmp2 = LTmp ) ; InLife1 = [Reg|InLife], constraints(Reg, InLife, Alias, Cstr), make_imposs(Cstr, [Reg], LTmp, LTmp1), ( var(Reg) -> update_tmp(LTmp1, Reg, Cstr, Wish, LTmp2) ; LTmp2 = LTmp1 ) ). handle_one_code(w(Reg), Alias, Wish, InLife, InLife1, LTmp, LTmp2) :- ( set_delete(InLife, Reg, InLife1) -> ( var(Reg), Wish \== [] -> update_tmp(LTmp, Reg, [], Wish, LTmp2) ; LTmp2 = LTmp ) ; InLife1 = InLife, ( var(Reg) -> constraints(Reg, InLife1, Alias, Cstr), ( Wish \== [] -> set_diff(Cstr, Wish, Cstr1) ; Cstr1 = Cstr ), make_imposs(Cstr1, [Reg], LTmp, LTmp1), update_tmp(LTmp1, Reg, Cstr1, Wish, LTmp2) ; LTmp2 = LTmp ) ). handle_one_code(c(Reg, Reg1), Alias, _, InLife, InLife2, LTmp, LTmp2) :- handle_one_code(w(Reg1), Alias, [Reg], InLife, InLife1, LTmp, LTmp1), handle_one_code(r(Reg), Alias, [Reg1], InLife1, InLife2, LTmp1, LTmp2). constraints(Reg, InLife, Alias, Cstr) :- ( g_read(reg_opt, 2), find_aliases_of(Alias, Reg, LSame) -> set_diff(InLife, LSame, Cstr) ; Cstr = InLife ). update_tmp([], Reg, Imposs, Wish, [tmp(Reg, Imposs, Wish)]). update_tmp([Tmp|LTmp], Reg, Imposs, Wish, [Tmp1|LTmp1]) :- Tmp = tmp(Reg1, Imposs1, Wish1), ( Reg == Reg1 -> set_union(Imposs, Imposs1, Imposs2), set_union(Wish, Wish1, Wish2), Tmp1 = tmp(Reg, Imposs2, Wish2), LTmp1 = LTmp ; Tmp1 = Tmp, update_tmp(LTmp, Reg, Imposs, Wish, LTmp1) ). remove_tmp([T|LTmp], Reg, Imposs, Wish, LTmp2) :- T = tmp(Reg1, Imposs1, Wish1), ( Reg == Reg1 -> Imposs = Imposs1, Wish = Wish1, LTmp2 = LTmp ; LTmp2 = [T|LTmp1], remove_tmp(LTmp, Reg, Imposs, Wish, LTmp1) ). make_imposs([], _, LTmp, LTmp). make_imposs([Reg|Cstr], Imposs, LTmp, LTmp2) :- ( var(Reg) -> update_tmp(LTmp, Reg, Imposs, [], LTmp1) ; LTmp1 = LTmp ), make_imposs(Cstr, Imposs, LTmp1, LTmp2). % Register assignment assign_lst_tmp(LTmp, MaxRegUsed) :- g_read(reg_opt, OptReg), ( OptReg = 2 -> assign_wishes(LTmp, LTmp1) ; no_wish(LTmp, OptReg, LTmp1) ), assign_values(LTmp1, -1, MaxRegUsed). assign_wishes([], []). assign_wishes([tmp(Tmp, Imposs, Wish)|LTmp], LTmp3) :- collapse_tmps(Wish, Imposs, LTmp, Tmp, Wish1, Imposs1, LTmp1), try_a_whish(Tmp, Imposs1, Wish1), ( var(Tmp) -> LTmp3 = [tmp(Tmp, Imposs1)|LTmp2] % no longer wish in tmp() ; LTmp3 = LTmp2 ), assign_wishes(LTmp1, LTmp2). collapse_tmps([], Imposs, LTmp, _, [], Imposs, LTmp). collapse_tmps([Reg|Wish], Imposs, LTmp, Tmp, Wish1, Imposs1, LTmp1) :- ( Reg == Tmp ; set_elt(Imposs, Reg) ), !, collapse_tmps(Wish, Imposs, LTmp, Tmp, Wish1, Imposs1, LTmp1). collapse_tmps([Arg|Wish], Imposs, LTmp, Tmp, [Arg|Wish1], Imposs1, LTmp1) :- integer(Arg), !, collapse_tmps(Wish, Imposs, LTmp, Tmp, Wish1, Imposs1, LTmp1). collapse_tmps([Tmp1|Wish], Imposs, LTmp, Tmp, Wish3, Imposs3, LTmp2) :- remove_tmp(LTmp, Tmp1, Imposs1, Wish1, LTmp1), set_union(Imposs, Imposs1, Imposs2), set_union(Wish, Wish1, Wish2), Tmp = Tmp1, collapse_tmps(Wish2, Imposs2, LTmp1, Tmp, Wish3, Imposs3, LTmp2). try_a_whish(Tmp, Imposs, Wish) :- set_diff(Wish, Imposs, [Tmp|_]), !. try_a_whish(_, _, _). no_wish([], _, []). no_wish([tmp(Tmp, Imposs, Wish)|LTmp], OptReg, [tmp(Tmp, Imposs1)|LTmp1]) :- ( OptReg = 0 -> set_union(Imposs, Wish, Imposs1) % no optimizations at all ; Imposs1 = Imposs ), % for some optimizations no_wish(LTmp, OptReg, LTmp1). assign_values([], MaxRegUsed, MaxRegUsed). assign_values([tmp(Tmp, Imposs)|LTmp], MaxRegUsed, MaxRegUsed2) :- sort(Imposs, Imposs1), find_hole(Imposs1, 0, Tmp), ( Tmp > MaxRegUsed -> MaxRegUsed1 = Tmp ; MaxRegUsed1 = MaxRegUsed ), assign_values(LTmp, MaxRegUsed1, MaxRegUsed2). find_hole([], Nb, Nb). find_hole([Reg|Imposs], Nb, Nb1) :- var(Reg), !, find_hole(Imposs, Nb, Nb1). find_hole([Reg|Imposs], Nb, Nb2) :- ( Reg > Nb -> Nb2 = Nb % hole found ; ( Reg == Nb -> Nb1 is Nb + 1 ; Nb1 = Nb ), find_hole(Imposs, Nb1, Nb2) ). % Set handling (without unification) set_add([], X, [X]). set_add([Y|L], X, [Y|L]) :- X == Y, !. set_add([Y|L], X, [Y|L1]) :- set_add(L, X, L1). set_delete([Y|L], X, L) :- % set_delete(L,X,L1) fails if X == Y, % X does not belong to L !. set_delete([Y|L], X, [Y|L1]) :- set_delete(L, X, L1). set_elt([Y|_], X) :- X == Y, !. set_elt([_|L], X) :- set_elt(L, X). set_inter([], _, []). set_inter([X|L1], L2, [X|L3]) :- set_elt(L2, X), !, set_inter(L1, L2, L3). set_inter([_|L1], L2, L3) :- set_inter(L1, L2, L3). set_union([], L2, L2). set_union([X|L1], L2, L3) :- set_elt(L2, X), !, set_union(L1, L2, L3). set_union([X|L1], L2, [X|L3]) :- set_union(L1, L2, L3). set_diff([], _, []). set_diff([X|L], L1, L3) :- ( set_elt(L1, X) -> L3 = L2 ; L3 = [X|L2] ), set_diff(L, L1, L2). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/swi_pl2wam�����������������������������������������������������������������0000755�0001750�0001750�00000000106�13021324543�015217� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh pl -g "op(0, fx, dynamic), [whole, swilib], go_other" -- $* ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/indexing.wam���������������������������������������������������������������0000644�0001750�0001750�00000055136�13021356407�015541� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : indexing.pl file_name('/home/diaz/GP/src/Pl2Wam/indexing.pl'). predicate(user:indexing/2,134,static,private,monofile,global,[ allocate(4), get_variable(y(0),1), put_atom(f,1), put_void(2), put_list(3), unify_void(1), unify_variable(y(1)), call(indexing1/4), put_variable(y(2),0), put_variable(y(3),1), call(cur_pred/2), put_value(y(2),0), put_value(y(3),1), put_value(y(0),2), put_value(y(1),3), call('$indexing/2_$aux1'/4), put_value(y(0),0), put_integer(1,1), put_void(2), deallocate, execute(allocate_labels/3)]). predicate(user:'$indexing/2_$aux1'/4,134,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), put_value(x(0),1), put_atom(cut,0), put_value(y(0),2), call(test_pred_info/3), cut(y(3)), math_fast_load_value(y(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(1)],[x(0)]), put_value(y(1),0), get_list(0), unify_variable(x(2)), unify_list, unify_variable(x(0)), unify_local_value(y(2)), get_structure(pragma_arity/1,2), unify_local_value(x(1)), get_structure(get_current_choice/1,0), unify_structure(x/1), unify_local_value(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(3),2), proceed]). predicate(user:indexing1/4,147,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), allocate(7), get_variable(y(0),1), get_list(3), unify_variable(x(1)), unify_variable(y(1)), get_structure(label/1,1), unify_local_value(x(2)), get_variable(y(2),4), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),3), put_variable(y(6),4), call(look_for_var/5), put_value(y(3),0), put_value(y(4),1), put_value(y(5),2), put_value(y(6),3), put_value(y(0),4), put_value(y(1),5), call(mk_indexing/6), cut(y(2)), deallocate, proceed]). predicate(user:look_for_var/5,154,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_integer(2,1), get_nil(2), get_nil(4), proceed, label(4), retry_me_else(6), label(5), get_nil(2), get_list(0), unify_variable(x(0)), unify_local_value(x(4)), get_structure(cl/3,0), unify_variable(x(2)), unify_atom(var), unify_variable(x(0)), get_structure(cl/3,3), unify_value(x(2)), unify_atom(var), unify_value(x(0)), cut(x(5)), put_value(x(4),0), execute('$look_for_var/5_$aux1'/2), label(6), trust_me_else_fail, label(7), allocate(2), get_variable(y(0),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_list(2), unify_value(x(1)), unify_variable(x(2)), put_variable(y(1),1), call(look_for_var/5), put_unsafe_value(y(1),0), put_value(y(0),1), deallocate, execute('$look_for_var/5_$aux2'/2)]). predicate(user:'$look_for_var/5_$aux2'/2,163,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(6), switch_on_term(2,fail,1,fail,fail), label(1), switch_on_integer([(13,3),(14,5)]), label(2), try_me_else(4), label(3), get_integer(13,0), cut(x(2)), get_integer(11,1), proceed, label(4), trust_me_else_fail, label(5), get_integer(14,0), cut(x(2)), get_integer(12,1), proceed, label(6), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(user:'$look_for_var/5_$aux1'/2,156,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_nil(0), cut(x(2)), get_integer(14,1), proceed, label(1), trust_me_else_fail, get_integer(13,1), proceed]). predicate(user:mk_indexing/6,175,static,private,monofile,global,[ pragma_arity(7), get_current_choice(x(6)), switch_on_term(2,fail,1,fail,fail), label(1), switch_on_integer([(11,3),(12,5),(13,7),(14,9),(2,11)]), label(2), try_me_else(4), label(3), allocate(9), get_integer(11,0), get_variable(y(0),1), get_structure(cl/3,2), unify_void(2), unify_variable(y(1)), get_variable(y(2),3), get_variable(y(3),5), put_value(x(4),0), put_variable(y(4),1), put_variable(y(5),2), call('$mk_indexing/6_$aux1'/3), put_integer(2,0), put_value(y(0),1), put_void(2), put_void(3), put_atom(f,4), put_variable(y(6),5), call(mk_indexing/6), put_value(y(2),0), put_atom(t,1), put_variable(y(7),2), put_variable(y(8),3), call(indexing1/4), put_value(y(3),0), get_list(0), unify_local_value(y(4)), unify_list, unify_local_value(y(6)), unify_list, unify_variable(x(1)), unify_list, unify_variable(x(0)), unify_list, unify_value(y(1)), unify_local_value(y(8)), get_structure(label/1,1), unify_local_value(y(5)), get_structure(retry_me_else/1,0), unify_local_value(y(7)), deallocate, proceed, label(4), retry_me_else(6), label(5), allocate(6), get_integer(12,0), get_variable(y(0),1), get_structure(cl/3,2), unify_void(2), unify_variable(y(1)), get_variable(y(2),5), put_value(x(4),0), put_variable(y(3),1), put_variable(y(4),2), call('$mk_indexing/6_$aux2'/3), put_integer(2,0), put_value(y(0),1), put_void(2), put_void(3), put_atom(f,4), put_variable(y(5),5), call(mk_indexing/6), put_value(y(2),0), get_list(0), unify_local_value(y(3)), unify_list, unify_local_value(y(5)), unify_list, unify_variable(x(0)), unify_list, unify_atom(trust_me_else_fail), unify_value(y(1)), get_structure(label/1,0), unify_local_value(y(4)), deallocate, proceed, label(6), retry_me_else(8), label(7), allocate(6), get_integer(13,0), get_structure(cl/3,2), unify_void(2), unify_variable(y(0)), get_variable(y(1),3), get_variable(y(2),5), put_value(x(4),0), put_variable(y(3),1), put_variable(y(4),2), call('$mk_indexing/6_$aux3'/3), put_value(y(1),0), put_atom(t,1), put_value(y(4),2), put_variable(y(5),3), call(indexing1/4), put_value(y(2),0), get_list(0), unify_local_value(y(3)), unify_list, unify_value(y(0)), unify_local_value(y(5)), deallocate, proceed, label(8), retry_me_else(10), label(9), get_integer(14,0), get_structure(cl/3,2), unify_void(2), unify_variable(x(2)), put_value(x(4),0), put_value(x(5),1), execute('$mk_indexing/6_$aux4'/3), label(10), trust_me_else_fail, label(11), allocate(18), get_integer(2,0), get_variable(y(0),1), get_variable(y(1),6), put_value(x(4),0), put_value(x(5),1), put_variable(y(2),2), call('$mk_indexing/6_$aux5'/3), put_value(y(0),0), put_variable(y(3),1), put_value(y(2),2), put_variable(y(4),3), put_variable(y(5),4), put_variable(y(6),5), put_variable(y(7),6), put_variable(y(8),7), call('$mk_indexing/6_$aux6'/8), put_value(y(3),0), get_variable(y(9),0), put_value(y(0),0), put_variable(y(10),1), put_variable(y(11),2), put_variable(y(12),3), put_variable(y(13),4), call(split/5), cut(y(1)), put_value(y(10),0), put_atom(switch_on_atom,1), put_value(y(5),2), put_variable(y(14),3), put_value(y(9),4), call(gen_switch/5), put_value(y(11),0), put_atom(switch_on_integer,1), put_value(y(6),2), put_variable(y(15),3), put_value(y(14),4), call(gen_switch/5), put_value(y(12),0), put_value(y(7),1), put_variable(y(16),2), put_value(y(15),3), call(gen_list/4), put_value(y(13),0), put_atom(switch_on_structure,1), put_value(y(8),2), put_variable(y(17),3), put_value(y(16),4), call(gen_switch/5), put_value(y(0),0), put_unsafe_value(y(4),1), put_unsafe_value(y(17),2), deallocate, execute(gen_insts/3)]). predicate(user:'$mk_indexing/6_$aux6'/8,206,static,private,monofile,local,[ pragma_arity(9), get_current_choice(x(8)), try_me_else(1), get_list(0), unify_void(1), unify_nil, cut(x(8)), get_list(1), unify_void(1), unify_variable(x(0)), get_value(x(0),2), proceed, label(1), trust_me_else_fail, get_list(2), unify_variable(x(0)), unify_local_value(x(1)), get_structure(switch_on_term/5,0), unify_local_value(x(3)), unify_local_value(x(4)), unify_local_value(x(5)), unify_local_value(x(6)), unify_local_value(x(7)), proceed]). predicate(user:'$mk_indexing/6_$aux5'/3,206,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(f,0), cut(x(3)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_list(1), unify_atom(trust_me_else_fail), unify_local_value(x(2)), proceed]). predicate(user:'$mk_indexing/6_$aux4'/3,200,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(f,0), cut(x(3)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_list(1), unify_atom(trust_me_else_fail), unify_local_value(x(2)), proceed]). predicate(user:'$mk_indexing/6_$aux3'/3,192,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(f,0), cut(x(3)), get_structure(try_me_else/1,1), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_structure(retry_me_else/1,1), unify_local_value(x(2)), proceed]). predicate(user:'$mk_indexing/6_$aux2'/3,184,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(f,0), cut(x(3)), get_structure(try_me_else/1,1), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_structure(retry_me_else/1,1), unify_local_value(x(2)), proceed]). predicate(user:'$mk_indexing/6_$aux1'/3,175,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(f,0), cut(x(3)), get_structure(try_me_else/1,1), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_structure(retry_me_else/1,1), unify_local_value(x(2)), proceed]). predicate(user:split/5,227,static,private,monofile,global,[ allocate(6), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),4), get_variable(x(1),3), put_structure(a/2,3), unify_variable(x(2)), unify_value(x(2)), put_structure(a/2,7), unify_nil, unify_local_value(x(1)), put_nil(1), put_nil(2), put_nil(4), put_variable(y(3),5), put_variable(y(4),6), put_variable(y(5),8), call(split1/9), put_value(y(3),0), put_value(y(0),1), call(terminate_list/2), put_value(y(4),0), put_value(y(1),1), call(terminate_list/2), put_unsafe_value(y(5),0), put_value(y(2),1), deallocate, execute(terminate_list/2)]). predicate(user:split1/9,234,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(8),4), get_value(x(7),3), get_value(x(6),2), get_value(x(5),1), proceed, label(3), trust_me_else_fail, label(4), allocate(9), get_variable(y(1),5), get_variable(y(2),6), get_variable(y(3),7), get_variable(y(4),8), get_variable(x(5),4), get_variable(x(4),3), get_variable(x(3),2), get_variable(x(2),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure(cl/3,0), unify_variable(x(1)), unify_variable(x(0)), unify_void(1), put_variable(y(5),6), put_variable(y(6),7), put_variable(y(7),8), put_variable(y(8),9), call(split2/10), put_value(y(0),0), put_unsafe_value(y(5),1), put_unsafe_value(y(6),2), put_unsafe_value(y(7),3), put_unsafe_value(y(8),4), put_value(y(1),5), put_value(y(2),6), put_value(y(3),7), put_value(y(4),8), deallocate, execute(split1/9)]). predicate(user:split2/10,241,static,private,monofile,global,[ switch_on_term(2,7,fail,fail,1), label(1), switch_on_structure([(atm/1,3),(int/1,5),(stc/2,9)]), label(2), try_me_else(4), label(3), get_value(x(9),5), get_value(x(8),4), get_value(x(7),3), get_variable(x(3),2), get_variable(x(2),1), get_structure(atm/1,0), unify_variable(x(1)), put_value(x(3),0), put_value(x(6),3), execute(add_to_list/4), label(4), retry_me_else(6), label(5), get_value(x(9),5), get_value(x(8),4), get_value(x(6),2), get_variable(x(2),1), get_structure(int/1,0), unify_variable(x(1)), put_value(x(3),0), put_value(x(7),3), execute(add_to_list/4), label(6), retry_me_else(8), label(7), get_atom(lst,0), get_value(x(9),5), get_value(x(7),3), get_value(x(6),2), get_structure(a/2,4), unify_variable(x(2)), unify_variable(x(0)), get_list(2), unify_local_value(x(1)), unify_variable(x(1)), get_structure(a/2,8), unify_value(x(1)), unify_value(x(0)), proceed, label(8), trust_me_else_fail, label(9), get_value(x(8),4), get_value(x(7),3), get_value(x(6),2), get_variable(x(2),1), get_structure(stc/2,0), unify_variable(x(3)), unify_variable(x(0)), put_structure((/)/2,1), unify_value(x(3)), unify_value(x(0)), put_value(x(5),0), put_value(x(9),3), execute(add_to_list/4)]). predicate(user:add_to_list/4,255,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_list(3), unify_variable(x(0)), unify_nil, get_structure(a/3,0), unify_local_value(x(1)), unify_variable(x(0)), unify_list, unify_local_value(x(2)), unify_value(x(0)), proceed, label(4), retry_me_else(6), label(5), get_list(0), unify_variable(x(0)), unify_variable(x(5)), get_structure(a/3,0), unify_local_value(x(1)), unify_variable(x(6)), unify_variable(x(0)), get_list(6), unify_local_value(x(2)), unify_variable(x(2)), get_list(3), unify_variable(x(3)), unify_value(x(5)), get_structure(a/3,3), unify_local_value(x(1)), unify_value(x(2)), unify_value(x(0)), cut(x(4)), proceed, label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(4)), unify_variable(x(0)), get_list(3), unify_value(x(4)), unify_variable(x(3)), execute(add_to_list/4)]). predicate(user:terminate_list/2,266,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(2)), unify_variable(x(0)), get_structure(a/3,2), unify_variable(x(3)), unify_nil, unify_variable(x(2)), get_list(1), unify_variable(x(4)), unify_variable(x(1)), get_structure(a/2,4), unify_value(x(3)), unify_value(x(2)), execute(terminate_list/2)]). predicate(user:gen_switch/5,274,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(5), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_atom(fail,2), get_value(x(4),3), cut(x(5)), proceed, label(3), trust_me_else_fail, label(4), get_value(x(4),3), get_list(0), unify_variable(x(0)), unify_nil, get_structure(a/2,0), unify_void(1), unify_list, unify_local_value(x(2)), unify_nil, cut(x(5)), proceed, label(5), trust_me_else_fail, allocate(3), get_variable(y(0),1), get_variable(x(1),3), get_list(4), unify_variable(x(4)), unify_list, unify_variable(y(1)), unify_variable(x(3)), get_structure(label/1,4), unify_local_value(x(2)), put_value(x(1),2), put_variable(y(2),1), call(create_switch_list/4), put_value(y(1),0), put_list(1), unify_local_value(y(0)), unify_list, unify_local_value(y(2)), unify_nil, call_c('Pl_Blt_Univ',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed]). predicate(user:create_switch_list/4,295,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure(a/2,0), unify_variable(x(2)), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), get_structure((',')/2,1), unify_value(x(2)), unify_variable(x(1)), put_variable(y(3),2), call(gen_list/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(create_switch_list/4)]). predicate(user:gen_list/4,304,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_atom(fail,1), get_value(x(3),2), proceed, label(4), retry_me_else(6), label(5), get_value(x(3),2), get_list(0), unify_local_value(x(1)), unify_nil, cut(x(4)), proceed, label(6), trust_me_else_fail, label(7), get_variable(x(4),2), get_list(0), unify_variable(x(5)), unify_variable(x(0)), get_list(3), unify_variable(x(6)), unify_list, unify_variable(x(3)), unify_variable(x(2)), get_structure(label/1,6), unify_local_value(x(1)), get_structure(try/1,3), unify_value(x(5)), put_value(x(4),1), execute(gen_list1/3)]). predicate(user:gen_list1/3,314,static,private,monofile,global,[ switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), get_list(0), unify_variable(x(0)), unify_nil, get_list(2), unify_variable(x(2)), unify_local_value(x(1)), get_structure(trust/1,2), unify_value(x(0)), proceed, label(4), trust_me_else_fail, label(5), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_variable(x(4)), unify_variable(x(2)), get_structure(retry/1,4), unify_value(x(3)), execute(gen_list1/3)]). predicate(user:gen_insts/3,323,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), get_list(0), unify_variable(x(0)), unify_nil, get_structure(cl/3,0), unify_local_value(x(1)), unify_void(1), unify_variable(x(4)), get_list(2), unify_variable(x(0)), unify_value(x(4)), get_structure(label/1,0), unify_local_value(x(1)), cut(x(3)), proceed, label(4), trust_me_else_fail, label(5), allocate(6), get_variable(y(2),1), get_variable(y(3),2), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_structure(cl/3,1), unify_variable(y(0)), unify_void(1), unify_variable(y(1)), put_variable(y(4),1), put_variable(y(5),2), call(gen_insts1/3), put_value(y(3),0), get_list(0), unify_variable(x(2)), unify_list, unify_variable(x(1)), unify_list, unify_variable(x(0)), unify_list, unify_value(y(1)), unify_local_value(y(5)), get_structure(label/1,2), unify_local_value(y(2)), get_structure(try_me_else/1,1), unify_local_value(y(4)), get_structure(label/1,0), unify_value(y(0)), deallocate, proceed]). predicate(user:gen_insts1/3,332,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), get_list(0), unify_variable(x(0)), unify_nil, get_structure(cl/3,0), unify_variable(x(0)), unify_void(1), unify_variable(x(5)), get_list(2), unify_variable(x(4)), unify_list, unify_atom(trust_me_else_fail), unify_list, unify_variable(x(2)), unify_value(x(5)), get_structure(label/1,4), unify_local_value(x(1)), get_structure(label/1,2), unify_value(x(0)), cut(x(3)), proceed, label(4), trust_me_else_fail, label(5), allocate(6), get_variable(y(2),1), get_variable(y(3),2), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_structure(cl/3,1), unify_variable(y(0)), unify_void(1), unify_variable(y(1)), put_variable(y(4),1), put_variable(y(5),2), call(gen_insts1/3), put_value(y(3),0), get_list(0), unify_variable(x(2)), unify_list, unify_variable(x(1)), unify_list, unify_variable(x(0)), unify_list, unify_value(y(1)), unify_local_value(y(5)), get_structure(label/1,2), unify_local_value(y(2)), get_structure(retry_me_else/1,1), unify_local_value(y(4)), get_structure(label/1,0), unify_value(y(0)), deallocate, proceed]). predicate(user:allocate_labels/3,342,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(7), switch_on_term(1,2,fail,4,6), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), cut(x(3)), proceed, label(3), retry_me_else(5), label(4), allocate(3), get_variable(y(1),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(3)), put_variable(y(2),2), call(allocate_labels/3), put_value(y(0),0), put_unsafe_value(y(2),1), put_value(y(1),2), deallocate, execute(allocate_labels/3), label(5), trust_me_else_fail, label(6), get_structure(label/1,0), unify_local_value(x(1)), cut(x(3)), math_fast_load_value(x(1),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_value(x(2),0), proceed, label(7), trust_me_else_fail, get_value(x(2),1), proceed]). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000113�13021324543�015173� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile *.wam1 *.po *.itf ?.pl TO_DO pl2wam pl2wam0 spl2wam make_bip_list �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/read_file.pl���������������������������������������������������������������0000644�0001750�0001750�00000116755�13021324543�015476� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : read_file.pl * * Descr.: source file reading * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * Data structures: * * * * the stack of opened files (for nested includes): * * global variable open_file_stack = [PlFile*Stream,...] * * from last to first. * * * * the context (where occurs an error): * * global variable where = OpenFileStack+(L1-L2) * * L1 = first line of the current clause (resp. directive). * * L2 = last line of the current clause (resp. directive). * * * * read_predicate(Pred,N,LSrcCl): * * the structure of the compiler is a repeat/fail loop on 1 predicate * * calling read_predicate(Pred,N,LSrcCl) to obtain next predicate. * * Pred = predicate name (an atom). * * N = arity (an integer >=0). * * LSrcCl = [SrcCl,...], list of source clauses, with * * SrcCl = Where+Cl where Cl is the source clause read. * * * * Buffers for special predicate management (with assert/retract): * * * * buff_aux_pred(Pred,N,LSrcCl): * * records the clauses of an auxiliary predicate. * * Asserted by Pass 1 (syntactic sugar removing) when splitting ;/2,etc.* * Retracted at the very next invocation of read_predicate/3 to * * ensure that aux. predicates always follow their "father" predicate. * * * * buff_discontig_clause(Pred,N,SrcCl): * * records a clause of a discontiguous predicate (:- discontiguous). * * Eacho clause of a discontiguous predicate is asserted when it is read* * When the end of file is reached all clauses of a discontiguous pred * * are grouped to return a list of source clauses LSrcCl. * * Thus discontiguous predicates are always compiled after other * * predicates. * * * * buff_dyn_interf_clause(Pred,N,SrcCl): * * records the interface clause of a dynamic predicate (:- dynamic). * * This clause is of the form Head:- call(Head) and only ensures that * * an external invocation to this predicate will not need to know that * * it is dynamic (and should be called by call/1). * * Asserted as soon as a :- dynamic directive is encountered. * * Retracted only when the end of file is reached. All other clauses of * * a dynamic predicate give rise to a system executable directive to * * assert(z) it. * * * * empty_dyn_pred(Pred,N,Where): * * asserted when the declaration of a dynamic predicate is encoutered * * (:- dynamic). Retracted when a clause of a dynamic predicate is read.* * At the end, only contains dynamic predicate with no clauses. * * Used then to define the interface clause. * * * * ensure_linked(Pred,N): * * asserted for each Pred/N occuring in a :- ensure_linked directive. * * * * module_export(Pred,N): * * asserted for each exported Pred/N from the module. * * * * module_import(Pred,N,Module,PredOrig): * * asserted for each imported Pred/N from Module (PredOrig is for as/2).* * * * meta_pred(Pred,N,MetaDecl): * * asserted for each meta_predicate declaration. * * * * Buffers for executable directive management (with assert/retract): * * * * buff_exe_system(SrcDirec) * * SrcDirec = Where+Body (i.e. source directive). * * records a system directive. * * Asserted for dynamic clauses (to assertz it), and to execute, at * * run-time, op/3 set_prolog_flag/2, char_conversion/2. * * Retracted only when the end of file has been reached to provide a * * predicate '$exe_system':- Body. * * * * buff_exe_user(SrcDirec) * * records user defined directives (:- initialization). * * Asserted when a :- initialization declaration is encountered. * * Retracted just after all '$buff_exe_system' to ensure that any user * * directive has the needed environment. * * * * Buffers for special clause management (with assert/retract): * * * * buff_clause(Pred,N,SrcCl): * * the reader needs a lookahead clause (to group clauses by predicates).* * For such a clause we assert/retract(buff_clause(Pred,N,SrcCl)). * * Read at the very next invocation of get_next_clause/3. * *-------------------------------------------------------------------------*/ :- op(200, fx, ?). read_file_init(PlFile) :- retractall(buff_clause(_, _, _)), retractall(buff_aux_pred(_, _, _)), retractall(buff_discontig_clause(_, _, _)), retractall(buff_dyn_interf_clause(_, _, _)), retractall(buff_exe_system(_)), retractall(buff_exe_user(_)), retractall(empty_dyn_pred(_, _, _)), retractall(ensure_linked(_, _)), retractall(pred_info(_, _, _)), retractall(module_export(_, _)), retractall(module_import(_, _, _, _)), retractall(meta_pred(_, _, _)), g_assign(module, user), g_assign(module_already_seen, f), g_assign(default_kind, user), g_assign(reading_dyn_pred, f), g_assign(eof_reached, f), g_assign(open_file_stack, []), g_assign(if_stack, []), g_assign(where, 0), g_assign(syn_error_nb, 0), g_assign(in_lines, 0), g_assign(in_bytes, 0), open_new_prolog_file(PlFile). read_file_term(Bytes, Lines) :- g_read(in_bytes, Bytes), g_read(in_lines, Lines). read_file_error_nb(SynErrNb) :- g_read(syn_error_nb, SynErrNb). open_new_prolog_file(PlFile0) :- g_read(open_file_stack, OpenFileStack), prolog_file_name(PlFile0, PlFile), open_new_prolog_file1(PlFile, OpenFileStack, PlFile1, Stream), !, g_assign(open_file_stack, [PlFile1 * Stream|OpenFileStack]), ( peek_char(Stream, '#'), % ignore #! starting line (for shebang support) repeat, get_char(Stream, X), (X = '\n' ; X = end_of_file) ; true ). open_new_prolog_file1(user, _, user, Stream) :- current_input(Stream). open_new_prolog_file1(PlFile, _, PlFile, Stream) :- % format('~n*** Trying to open ~a~n', [PlFile]), catch(open(PlFile, read, Stream), error(existence_error(source_sink, _), _), fail). open_new_prolog_file1(PlFile, OpenFileStack, PlFile1, Stream) :- % format('file stack: ~w~n', [OpenFileStack]), is_relative_file_name(PlFile), try_other_directory(OpenFileStack, PlFile, PlFile1, Stream). open_new_prolog_file1(PlFile, _, _, _) :- throw(error(existence_error(source_sink, PlFile), open/3)). /* If an included file is not found try to look in "parents" (includers) path. * If found return the new name (to have correct error msg and file_name in .wam) */ try_other_directory([PlFile1 * _|_], PlFile, PlFile2, Stream) :- decompose_file_name(PlFile1, Directory, _, _), Directory \== '', atom_concat(Directory, PlFile, PlFile2), % format(' fail.~n+++ Trying to open ~a~n', [PlFile2]), catch(open(PlFile2, read, Stream), _, fail). try_other_directory([_|OpenFileStack], PlFile, PlFile1, Stream) :- try_other_directory(OpenFileStack, PlFile, PlFile1, Stream). close_last_prolog_file :- g_read(open_file_stack, [_ * Stream|OpenFileStack]), g_assign(open_file_stack, OpenFileStack), g_read(in_bytes, Bytes1), g_read(in_lines, Lines1), character_count(Stream, Bytes2), line_count(Stream, Lines2), Bytes is Bytes1 + Bytes2, Lines is Lines1 + Lines2, g_assign(in_bytes, Bytes), g_assign(in_lines, Lines), close(Stream). % Read of a predicate read_predicate(Pred, N, LSrcCl) :- repeat, read_predicate1(Pred, N, LSrcCl), % standard predicate % !, ( g_read(reading_dyn_pred, f), g_read(native_code, t) -> read_predicate_next(Pred, N, LSrcCl) ; true ). read_predicate_next(Pred, N, LSrcCl) :- (test_pred_info(dyn, Pred, N) ; test_pred_info(multi, Pred, N)), !, LSrcCl = [Where + _|_], add_dyn_interf_clause(Pred, N, Where), create_exe_clauses_for_dyn_pred(LSrcCl, Pred, N), fail. % backtrack to repeat of main loop read_predicate_next(Pred, N, LSrcCl) :- test_pred_info(pub, Pred, N), !, create_exe_clauses_for_pub_pred(LSrcCl). read_predicate_next(_, _, _). read_predicate1(Pred, N, LSrcCl) :- retract(buff_aux_pred(Pred, N, LSrcCl)), !. % aux. pred (cf syn_sugar) read_predicate1(Pred, N, LSrcCl) :- g_read(eof_reached, f), !, repeat, get_next_clause(Pred, N, SrcCl), SrcCl = _ + Cl, retractall(empty_dyn_pred(Pred, N, _)), ( test_pred_info(discontig, Pred, N) -> assertz(buff_discontig_clause(Pred, N, SrcCl)), define_predicate(Pred, N), fail % backtrack to read_predicate1 ; true ), ( test_pred_info(def, Pred, N) -> warn('discontiguous predicate ~q - clause ignored', [Pred / N]), fail % backtrack to read_predicate1 ; true ), !, Cl \== end_of_file, % if end_of_file is read, fail % and backtrack to read_predicate1 define_predicate(Pred, N), group_clauses_by_pred(Pred, N, SrcCl, LSrcCl). read_predicate1(Pred, N, [SrcCl|LSrcCl]) :- retract(buff_discontig_clause(Pred, N, SrcCl)), !, % discontiguous pred recover_discontig_clauses(Pred, N, LSrcCl). read_predicate1(Pred, N, [SrcCl]) :- g_assign(reading_dyn_pred, t), retract(buff_dyn_interf_clause(Pred, N, SrcCl)), !. % dyn predicate read_predicate1(Pred, N, [SrcCl]) :- g_assign(reading_dyn_pred, t), retract(empty_dyn_pred(Pred, N, Where)), % empty dyn predicate define_predicate(Pred, N), ( g_read(native_code, t) -> create_dyn_interf_clause(Pred, N, Where, SrcCl) ; SrcCl = Where + '$$empty$$predicate$$clause$$' ), !. read_predicate1(Pred, N, LSrcCl) :- g_assign(reading_dyn_pred, f), retract(buff_exe_system(Where + Body)), % system exe directives Pred = '$exe_system', N = 0, LSrcCl = [Where + (Pred :- Body)], !. read_predicate1(Pred, N, LSrcCl) :- retract(buff_exe_user(Where + Body)), % user exe directives Pred = '$exe_user', N = 0, LSrcCl = [Where + (Pred :- Body)], !. read_predicate1(Pred, N, LSrcCl) :- Pred = end_of_file, N = 0, LSrcCl = [], !. % end of file group_clauses_by_pred(Pred, N, SrcCl, [SrcCl|LSrcCl1]) :- get_next_clause(Pred1, N1, SrcCl1), ( Pred = Pred1, N = N1 -> group_clauses_by_pred(Pred1, N1, SrcCl1, LSrcCl1) ; LSrcCl1 = [], ( Pred1 = end_of_file, N1 = 0 -> true ; asserta(buff_clause(Pred1, N1, SrcCl1)) ) ). add_dyn_interf_clause(Pred, N, _) :- clause(buff_dyn_interf_clause(Pred, N, _), true), !. % already asserted add_dyn_interf_clause(Pred, N, Where) :- create_dyn_interf_clause(Pred, N, Where, SrcCl), assertz(buff_dyn_interf_clause(Pred, N, SrcCl)). create_dyn_interf_clause(Pred, N, Where, SrcCl) :- length(LArgs, N), Head =.. [Pred|LArgs], SrcCl = Where + (Head :- call(Head)). recover_discontig_clauses(Pred, N, [SrcCl|LSrcCl]) :- retract(buff_discontig_clause(Pred, N, SrcCl)), !, recover_discontig_clauses(Pred, N, LSrcCl). recover_discontig_clauses(_, _, []). create_exe_clauses_for_dyn_pred([], _, _). create_exe_clauses_for_dyn_pred([SrcCl|LSrcCl], Pred, N) :- SrcCl = Where + Cl, get_file_name(Where, PlFile), add_wrapper_to_dyn_clause(Pred, N, Where + Cl, AuxName), get_owner_module(Pred, N, Module, Pred), handle_initialization(system, ('$call_c'('Pl_Emit_BC_Execute_Wrapper'(Module, Pred, N, '&', AuxName, N), [by_value]), '$add_clause_term'(Module, Cl, PlFile)), Where), create_exe_clauses_for_dyn_pred(LSrcCl, Pred, N). create_exe_clauses_for_pub_pred([]). create_exe_clauses_for_pub_pred([Where + Cl|LSrcCl]) :- get_file_name(Where, PlFile), handle_initialization(system, '$add_clause_term'(Cl, PlFile), Where), create_exe_clauses_for_pub_pred(LSrcCl). get_file_name([PlFile * _|_] + _, PlFile). get_next_clause(Pred, N, SrcCl) :- retract(buff_clause(Pred, N, SrcCl)), SrcCl = Where + _, g_assign(where, Where), !. get_next_clause(Pred, N, SrcCl) :- g_read(open_file_stack, OpenFileStack), OpenFileStack = [_ * Stream|_], '$catch'(read_term(Stream, Cl, [singletons(SingNames)]), error(syntax_error(Err), _), after_syn_error, user, any, 0), ( var(Err) -> last_read_start_line_column(L1, _), '$catch'(expand_term(Cl, Cl1), error(Err, _), dcg_error(Err), user, any, 0), stream_line_column(Stream, Line, Col), ( Col = 1 -> L2 is Line - 1 ; L2 = Line ), Where = OpenFileStack + (L1 - L2), g_assign(where, Where), get_next_clause1(Cl1, Where, SingNames, Pred, N, SrcCl) ; get_next_clause(Pred, N, SrcCl) ), !. get_next_clause1(end_of_file, _, _, Pred, N, SrcCl) :- close_last_prolog_file, g_read(open_file_stack, OpenFileStack), ( OpenFileStack = [] -> Pred = end_of_file, N = 0, SrcCl = _ + end_of_file, g_assign(eof_reached, t), ( g_read(if_stack, []) -> true ; error('endif directive expected', []) ) ; get_next_clause(Pred, N, SrcCl) ). % +++++ begin preprocessor management +++++ get_next_clause1((:- if(Goal)), _, _, Pred, N, SrcCl) :- !, g_read(if_stack, IfStack), ( '$catch'(Goal, Err, (warn('if directive caused exception: ~w', [Err]), fail), user, any, 0) -> g_assign(if_stack, [if(then, 1)|IfStack]) ; g_assign(if_stack, [if(then, 0)|IfStack]) ), get_next_clause(Pred, N, SrcCl). get_next_clause1((:- elif(Goal)), _, _, Pred, N, SrcCl) :- !, ( g_read(if_stack, [if(then, Keep)|IfStack]) -> ( Keep = 0 -> ( '$catch'(Goal, Err, (warn('elif directive caused exception: ~w', [Err]), fail), user, any, 0) -> g_assign(if_stack, [if(then, 1)|IfStack]) ; g_assign(if_stack, [if(then, 0)|IfStack]) ) ; g_assign(if_stack, [if(then, 2)|IfStack]) % 2 means ignore both the then and else part ) ; error('unexpected elif directive', []) ), get_next_clause(Pred, N, SrcCl). get_next_clause1((:- else), _, _, Pred, N, SrcCl) :- !, ( g_read(if_stack, [if(then, Keep)|IfStack]) -> Keep1 is 1 - Keep, g_assign(if_stack, [if(else, Keep1)|IfStack]) ; error('unexpected else directive', []) ), get_next_clause(Pred, N, SrcCl). get_next_clause1((:- endif), _, _, Pred, N, SrcCl) :- !, ( g_read(if_stack, [if(_, _)|IfStack]) -> g_assign(if_stack, IfStack) ; error('unexpected endif directive', []) ), get_next_clause(Pred, N, SrcCl). get_next_clause1(_, _, _, Pred, N, SrcCl) :- % preprocessor ignores a clause g_read(if_stack, [if(_, Keep)|_]), Keep \== 1, !, % ignore Keep = 0 and Keep = 2 or 1-2 = -1 get_next_clause(Pred, N, SrcCl). % +++++ end preprocessor management +++++ get_next_clause1((:- D), Where, SingNames, Pred, N, SrcCl) :- display_singletons(SingNames, directive), ( g_read(foreign_only, f) ; functor(D, foreign, _) ), ( handle_directive(D, Where) ; error('invalid directive ~q', [D]) ), !, get_next_clause(Pred, N, SrcCl). get_next_clause1(Cl, Where, SingNames, Pred, N, Where + Cl) :- g_read(foreign_only, f), !, ( Cl = (Head :- _) ; Cl = Head ), ( nonvar(Head) -> true ; error('head is a variable', []) ), ( callable(Head) -> true ; error('head is not a callable (~q)', [Head]) ), functor(Head, Pred, N), check_head_is_module_free(Head), check_module_clash(Pred, N), check_predicate(Pred, N), display_singletons(SingNames, Pred / N). % ignore clause with --foreign-only get_next_clause1(_, _, _, Pred, N, SrcCl) :- get_next_clause(Pred, N, SrcCl). after_syn_error :- g_read(syn_error_nb, SynErrNb), SynErrNb1 is SynErrNb + 1, g_assign(syn_error_nb, SynErrNb1), syntax_error_info(_, Line, Column, Msg), g_read(open_file_stack, OpenFileStack), g_assign(where, OpenFileStack + (Line - Line)), disp_msg('syntax error', Column, '~a', [Msg]). dcg_error(Err) :- last_read_start_line_column(Line, _), g_read(open_file_stack, OpenFileStack), g_assign(where, OpenFileStack + (Line - Line)), error('DCG error raised: ~w', [Err]). display_singletons(SingNames, PI) :- g_read(singl_warn, t), !, get_singletons(SingNames, Sing), ( Sing = [] -> true ; warn('singleton variables ~w for ~q', [Sing, PI]) ). display_singletons(_, _). get_singletons([], []). get_singletons([X = _|SingNames], Sing1) :- ( sub_atom(X, 0, 1, _, '_') -> Sing1 = Sing ; Sing1 = [X|Sing] ), get_singletons(SingNames, Sing). :- discontiguous(handle_directive / 3). handle_directive(D, Where) :- D =.. [DName|DLst], handle_directive(DName, DLst, Where). handle_directive(public, DLst, _) :- !, DLst \== [], set_flag_for_preds(DLst, pub). handle_directive(dynamic, DLst, Where) :- !, DLst \== [], set_flag_for_preds(DLst, dyn), set_flag_for_preds(DLst, pub), add_empty_dyn(DLst, Where). handle_directive(multifile, DLst, Where) :- !, DLst \== [], set_flag_for_preds(DLst, multi), add_empty_dyn(DLst, Where). handle_directive(discontiguous, DLst, _) :- !, DLst \== [], set_flag_for_preds(DLst, discontig). handle_directive(built_in, DLst, _) :- !, ( DLst == [], g_assign(default_kind, built_in) ; DLst \== [], set_flag_for_preds(DLst, bpl) ), !. handle_directive(built_in_fd, DLst, _) :- !, ( DLst == [], g_assign(default_kind, built_in_fd) ; DLst \== [], set_flag_for_preds(DLst, bfd) ). handle_directive(ensure_linked, DLst, _) :- !, ( g_read(native_code, f) -> warn('ensure_linked directive ignored in byte-code compilation mode', []) ; DLst \== [], add_ensure_linked(DLst) ). handle_directive(encoding, _, _) :- !, warn('encoding directive not supported - directive ignored', []). handle_directive(ensure_loaded, _, _) :- !, warn('ensure_loaded directive not supported - directive ignored', []). handle_directive(include, [PlFile], _) :- !, open_new_prolog_file(PlFile). handle_directive(op, [X, Y, Z], Where) :- !, exec_directive(op(X, Y, Z)), handle_initialization(system, op(X, Y, Z), Where). handle_directive(char_conversion, [X, Y], Where) :- !, exec_directive(char_conversion(X, Y)), handle_initialization(system, char_conversion(X, Y), Where). handle_directive(set_prolog_flag, [X, Y], Where) :- !, exec_directive(set_prolog_flag(X, Y)), ( current_prolog_flag(singleton_warning, off) -> g_assign(singl_warn, f) ; g_assign(singl_warn, t) ), handle_initialization(system, set_prolog_flag(X, Y), Where). handle_directive(initialization, [Body], Where) :- !, handle_initialization(user, Body, Where). handle_directive(module, [Module, ExportLst], _) :- !, ( g_read(module_already_seen, f) -> check_module_name_decl(Module, Module1), g_assign(module_already_seen, t), g_assign(module, Module1), add_module_export_info(ExportLst) ; error('directive module already declared', []) ). handle_directive(use_module, [Module], Where) :- !, handle_directive(use_module, [Module, all], Where). handle_directive(use_module, [Module, Imports], _) :- !, load_module_interface(Module, Imports, Module1, ImportLst), %format('load module interface ~w: imports: ~w~n', [Module, ImportLst]), add_module_import_info(ImportLst, Module1). handle_directive(meta_predicate, [MetaDecl], Where) :- % FIXME accept several MetaDecls !, ( callable(MetaDecl) -> functor(MetaDecl, Pred, N), set_flag_for_preds(Pred/N, meta), assertz(meta_pred(Pred, N, MetaDecl)), get_module_of_pred(Pred, N, Module), handle_initialization(system, '$declare_meta_predicate'(Module, MetaDecl), Where) ; error('invalid directive meta_predicate/1 ~w', [MetaDecl]) ). handle_directive(foreign, [Template], Where) :- !, handle_directive(foreign, [Template, []], Where). handle_directive(foreign, _, _) :- g_read(call_c, f), !, warn('foreign directive ignored (not allowed in this mode)', []). handle_directive(foreign, [Template, Options], Where) :- !, callable(Template), list(Options), functor(Template, Pred, N), ( test_pred_info(pub, Pred, N) -> error('foreign predicate ~q should not be public/dynamic', [Pred/N]) ; true), define_predicate(Pred, N), g_assign(foreign_fct_name, Pred), g_assign(foreign_return, boolean), g_assign(foreign_bip, Pred/N), g_assign(foreign_choice_size, -1), foreign_get_options(Options), foreign_check_types(0, N, Template, LType), g_read(foreign_fct_name, FctName), g_read(foreign_return, Return), g_read(foreign_bip, BipPred), g_read(foreign_choice_size, ChcSize), no_internal_transf(args(FctName, Return, BipPred, ChcSize, LType), Args), functor(Head, Pred, N), SrcCl = Where + (Head :- '$foreign_call_c'(Args)), assertz(buff_discontig_clause(Pred, N, SrcCl)), add_ensure_linked('$force_foreign_link' / 0). % to force the link of foreign.o and then foreign_supp.o foreign_get_options([]). foreign_get_options([X|Options]) :- foreign_get_options1(X), !, foreign_get_options(Options). foreign_get_options1(fct_name(FctName)) :- atom(FctName), g_assign(foreign_fct_name, FctName). foreign_get_options1(return(Return)) :- atom(Return), ( Return = none ; Return = boolean ; Return = jump ), g_assign(foreign_return, Return). foreign_get_options1(bip_name(X)) :- nonvar(X), X = none, g_assign(foreign_bip, ''/ -1). foreign_get_options1(bip_name(BipName, BipArity)) :- atom(BipName), integer(BipArity), g_assign(foreign_bip, BipName/BipArity). foreign_get_options1(bip_name(BipName/BipArity)) :- atom(BipName), integer(BipArity), g_assign(foreign_bip, BipName/BipArity). foreign_get_options1(choice_size(ChcSize)) :- integer(ChcSize), g_assign(foreign_choice_size, ChcSize). foreign_check_types(N, N, _, []) :- !. foreign_check_types(I, N, Template, [(Mode, A)|LArgType]) :- I1 is I + 1, arg(I1, Template, Arg), nonvar(Arg), ( Arg = + A, Mode = in ; Arg = - A, Mode = out ; Arg = ? A, Mode = in_out ; Arg = term, A = term, Mode = in ), % term = +term nonvar(A), foreign_check_arg(A), foreign_check_types(I1, N, Template, LArgType). foreign_check_arg(integer). foreign_check_arg(positive). foreign_check_arg(float). foreign_check_arg(number). foreign_check_arg(atom). foreign_check_arg(boolean). foreign_check_arg(char). foreign_check_arg(in_char). foreign_check_arg(code). foreign_check_arg(in_code). foreign_check_arg(byte). foreign_check_arg(in_byte). foreign_check_arg(string). foreign_check_arg(chars). foreign_check_arg(codes). foreign_check_arg(term). handle_directive(DName, LArgs, _) :- length(LArgs, N), warn('unknown directive ~q - maybe use initialization/1 - directive ignored', [DName / N]). handle_initialization(system, Body, Where) :- assertz(buff_exe_system(Where + Body)). handle_initialization(user, Body, Where) :- assertz(buff_exe_user(Where + Body)). exec_directive(Goal) :- '$catch'(Goal, Err, exec_directive_exception(Goal, Err), user, any, 0), !. exec_directive(Goal) :- warn('directive failed (~q)', [Goal]). exec_directive_exception(Goal, Err) :- warn('directive failed (~q) with exception (~q)', [Goal, Err]). used_bips_via_call :- % to enforce the link of these bips op(_, _, _), char_conversion(_, _), set_prolog_flag(_, _), expand_term(_, _). add_empty_dyn([], _) :- !. add_empty_dyn([P1|P2], Where) :- !, add_empty_dyn(P1, Where), add_empty_dyn(P2, Where). add_empty_dyn((P1, P2), Where) :- !, add_empty_dyn(P1, Where), add_empty_dyn(P2, Where). add_empty_dyn(Pred / N, Where) :- ( clause(empty_dyn_pred(Pred, N, _), _) -> true ; assertz(empty_dyn_pred(Pred, N, Where)) ). add_ensure_linked([]) :- !. add_ensure_linked([P1|P2]) :- !, add_ensure_linked(P1), add_ensure_linked(P2). add_ensure_linked((P1, P2)) :- !, add_ensure_linked(P1), add_ensure_linked(P2). add_ensure_linked(Pred / N) :- clause(ensure_linked(Pred, N), true), !. add_ensure_linked(Pred / N) :- assertz(ensure_linked(Pred, N)). add_module_export_info([]) :- !. add_module_export_info([P1|P2]) :- !, add_module_export_info(P1), add_module_export_info(P2). add_module_export_info((P1, P2)) :- !, add_module_export_info(P1), add_module_export_info(P2). add_module_export_info(Pred/N) :- clause(module_export(Pred, N), true), !. add_module_export_info(Pred/N) :- assertz(module_export(Pred, N)), ( test_pred_info(def, Pred, N) -> check_module_clash(Pred, N) ; true ). add_module_import_info([], _) :- !. add_module_import_info([P1|P2], Module) :- !, add_module_import_info(P1, Module), add_module_import_info(P2, Module). add_module_import_info((P1, P2), Module) :- !, add_module_import_info(P1, Module), add_module_import_info(P2, Module). add_module_import_info(PredOrig / N as Pred, Module) :- !, atom(Pred), add_module_import_info1(Pred, N, Module, PredOrig). add_module_import_info(Pred / N, Module) :- add_module_import_info1(Pred, N, Module, Pred). add_module_import_info1(Pred, N, Module, _) :- clause(module_import(Pred, N, Module1, _), true), !, ( Module = Module1 -> true ; error('predicate ~w already imported from module ~w', [Pred/N, Module1]) ). add_module_import_info1(Pred, N, Module, PredOrig) :- assertz(module_import(Pred, N, Module, PredOrig)), ( test_pred_info(def, Pred, N) -> check_module_clash(Pred, N) ; true ). % module syntax in module/2 directive check_module_name_decl(Module, Module1) :- var(Module), !, % replace a var by file basename g_read(open_file_stack, [FileName * _|_]), % g_read(where, Where), Where = [FileName * _|_] + _, decompose_file_name(FileName, _, Module, _), check_module_name_decl(Module, Module1). check_module_name_decl(Module, Module) :- check_module_name_syntax(Module). % module syntax in use_module/2 directive check_module_name_use(Module, Module2) :- nonvar(Module), Module = library(Module1), !, check_module_name_use(Module1, Module2). % For the moment ignore the surrounding library(...) check_module_name_use(Module, Module) :- check_module_name_syntax(Module). % module syntax in M:G check_module_name_qualif(Module) :- var(Module), !. check_module_name_qualif(Module) :- check_module_name_syntax(Module). % Here Module must be an atom with valid syntax check_module_name_syntax(Module) :- atom(Module), \+ atom_property(Module, needs_quotes), !. % be less restrictive ? accept upper case check_module_name_syntax(Module) :- error('invalid module name (~q) should be an atom = valid file name', [Module]). check_head_is_module_free(Module:Head) :- !, error('module qualification is not allowed for the head of a clause (~w)', [Module:Head]). check_head_is_module_free(_). check_module_clash(Pred, N) :- % Pred/N is defined in current module check for clash with an import clause(module_import(Pred, N, Module, _), true), get_module_of_pred(Pred, N, Module1), Module \== Module1, !, error('clash on ~q - defined in module ~q (here) and imported from ~w', [Pred/N, Module1, Module]). check_module_clash(_, _). % used to know how to qualify a call to a predicate (see internal.pl/code_gen.pl) get_owner_module(Pred, N, Module, Pred) :- clause(module_export(Pred, N), true), get_module_of_pred(Pred, N, Module), Module \== system, Module \== user, !. get_owner_module(Pred, N, Module, PredOrig) :- clause(module_import(Pred, N, Module, PredOrig), true), Module \== system, Module \== user, !. get_owner_module(Pred, _, _, Pred). is_exported(Pred, N) :- clause(module_export(Pred, N), true), !. get_module_of_pred(Pred, _, Module) :- % an aux is in the same module as its father '$aux_name'(Pred), !, '$father_of_aux_name'(Pred, Pred1, N), get_module_of_pred(Pred1, N, Module). get_module_of_pred(Pred, N, Module) :- ( test_pred_info(bpl, Pred, N) -> Module = system ; test_pred_info(bfd, Pred, N) -> Module = system ; g_read(module, Module) ). get_module_of_cur_pred(Module) :- cur_pred(Pred, N), get_module_of_pred(Pred, N, Module). load_module_interface(Module, Imports, Module1, ImportLst) :- check_module_name_use(Module, Module1), ( Module = library(_) -> current_prolog_flag(home, Home), atom_concat(Home, '/library/', D), atom_concat(D, Module1, File0) ; File0 = Module1 ), prolog_file_name(File0, PlFile), catch(load_module_interface1(PlFile, Module, ExportLst), Err, load_module_interface_err(Err, Module)), load_module_interface_compute_import_lst(Imports, Module, ExportLst, ImportLst), %format('from module ~w imports are: ~w~n', [Module, ImportLst]), true. load_module_interface1(PlFile, Module, ExportLst) :- open(PlFile, read, Stream), g_assign(loaded_export_list, '$$empty'), repeat, catch(read(Stream, T), _, fail), % ignore errors (FIXME report ? what with :- op/3) ( T = end_of_file -> ! ; T = (:- Directive), ( functor(Directive, module, A), A >= 2, A =< 3 -> arg(2, Directive, ExportLst), ( g_read(loaded_export_list, '$$empty') -> g_assign(loaded_export_list, ExportLst) ; warn('reading interface of ~w: more than one module directive - keep first', [Module]) ) ; Directive = meta_predicate(MetaDecl), % FIXME accept several MetaDecls % format('interface of ~w: read ~w~n', [Module, MetaDecl]), ( callable(MetaDecl) -> functor(MetaDecl, Pred, N), % set_flag_for_preds(Pred/N, meta), % useless for the moment assertz(meta_pred(Pred, N, MetaDecl)) ; warn('reading interface of ~w: invalid directive meta_predicate/1 ~w (ignored)', [Module, MetaDecl]) ) ), fail ), close(Stream), ( g_read(loaded_export_list, '$$empty') -> warn('no module directive found in ~w (still imported)', [Module]), ExportLst = [] ; g_read(loaded_export_list, ExportLst) ). load_module_interface_err(error(existence_error(source_sink, _), _), Module) :- warn('cannot open ~w - does not exist (still imported)', [Module]). load_module_interface_err(Err, Module) :- warn('reading interface of ~w raised an error ~w (ignored)', [Module, Err]). load_module_interface_compute_import_lst(all, _, ExportLst, ExportLst) :- !. load_module_interface_compute_import_lst(except(Lst), _, ExportLst, ImportLst) :- !, subtract(ExportLst, Lst, ImportLst). load_module_interface_compute_import_lst(ImportLst, Module, ExportLst, _) :- member(PI, ImportLst), ( PI = as(PI1, _) -> true ; PI1 = PI ), ( memberchk(PI1, ExportLst) -> true ; warn('~w is not currently exported by ~w (still imported)', [PI1, Module]) ), fail. load_module_interface_compute_import_lst(ImportLst, _, _, ImportLst). set_flag_for_preds([], _) :- !. set_flag_for_preds([P1|P2], Flag) :- !, set_flag_for_preds(P1, Flag), set_flag_for_preds(P2, Flag). set_flag_for_preds((P1, P2), Flag) :- !, set_flag_for_preds(P1, Flag), set_flag_for_preds(P2, Flag). set_flag_for_preds(Pred / N, Flag) :- atom(Pred), integer(N), ( test_pred_info(def, Pred, N) -> warn('directive occurs after definition of ~q - directive ignored', [Pred / N]) ; ( Flag = bpl, unset_pred_info(bfd, Pred, N) ; Flag = bfd, unset_pred_info(bpl, Pred, N) ; true ), !, set_pred_info(Flag, Pred, N) ). define_predicate(F, N) :- set_pred_info(def, F, N), test_pred_info(bpl, F, N), !. define_predicate(F, N) :- test_pred_info(bfd, F, N), !. define_predicate(F, N) :- g_read(default_kind, built_in), !, set_pred_info(bpl, F, N). define_predicate(F, N) :- g_read(default_kind, built_in_fd), !, set_pred_info(bfd, F, N). define_predicate(_, _). flag_bit(def, 0). flag_bit(dyn, 1). flag_bit(pub, 2). flag_bit(bpl, 3). flag_bit(bfd, 4). flag_bit(discontig, 5). flag_bit(cut, 6). flag_bit(meta, 7). flag_bit(multi, 8). set_pred_info(Flag, F, N) :- flag_bit(Flag, Bit), ( retract(pred_info(F, N, X)) ; X = 0 ), !, X1 is X \/ 1 << Bit, assertz(pred_info(F, N, X1)). unset_pred_info(Flag, F, N) :- flag_bit(Flag, Bit), retract(pred_info(F, N, X)), !, X1 is X /\ \ (1 << Bit), assertz(pred_info(F, N, X1)). unset_pred_info(_, _, _). test_pred_info(Flag, F, N) :- flag_bit(Flag, Bit), clause(pred_info(F, N, X), _), X /\ 1 << Bit > 0, !. test_pred_info(bpl, F, N) :- % an exported pred in system is a built_in - remove if not wanted g_read(module, system), is_exported(F, N). check_predicate(Pred, N) :- g_read(redef_error, t), control_construct(Pred, N), !, error('redefining control construct ~q', [Pred / N]). check_predicate(Pred, N) :- g_read(redef_error, t), bip(Pred, N), !, error('redefining built-in predicate ~q', [Pred / N]). check_predicate(Pred, N) :- g_read(susp_warn, t), suspicious_predicate(Pred, N), !, warn('suspicious predicate ~q', [Pred / N]). check_predicate(Pred, N) :- '$aux_name'(Pred), !, warn('using system auxiliary predicate ~q', [Pred / N]). check_predicate(_, _). bip(F, N) :- '$predicate_property1'(F, N, built_in), !. /* no longer needed built_in_fd ==> built_in bip(F, N) :- '$predicate_property1'(F, N, built_in_fd). */ control_construct(',', 2). control_construct(;, 2). control_construct(->, 2). control_construct(!, 0). control_construct(fail, 0). control_construct(true, 0). control_construct(call, 1). control_construct(catch, 3). control_construct(throw, 1). %suspicious_predicate(',', 2). %suspicious_predicate(;, 2). %suspicious_predicate(->, 2). %suspicious_predicate(!, 0). suspicious_predicate(:, 2). suspicious_predicate(:-, 1). suspicious_predicate(:-, 2). suspicious_predicate(-->, 2). suspicious_predicate({}, X) :- X < 2. suspicious_predicate(+, 2). suspicious_predicate(-, 2). suspicious_predicate(*, 2). suspicious_predicate(/, 2). suspicious_predicate(//, 2). warn(Msg, LArg) :- disp_msg(warning, 0, Msg, LArg). error(Msg, LArg) :- disp_msg('fatal error', 0, Msg, LArg), repeat, % close all opened files ( close_last_prolog_file -> fail ; ! ), abort. disp_msg(MsgType, Column, Msg, LArg) :- numbervars(LArg), g_read(where, Where), ( Where = OpenFileStack + L12, L12 = _ - _ -> disp_file_name(OpenFileStack, _), disp_lines(L12), disp_column(Column) ; true ), format('~a: ', [MsgType]), format(Msg, LArg), nl(user_output). disp_file_name([], '') :- !. disp_file_name([FileName * _|OpenFileStack], ' including ') :- disp_file_name(OpenFileStack, Before), format('~a~a', [Before, FileName]). disp_lines(L - L) :- !, format(':~d', [L]). disp_lines(L1 - L2) :- format(':~d-~d', [L1, L2]). disp_column(Column) :- Column > 0, !, format(':~d: ', [Column]). disp_column(_) :- write(': '). % Exception recovery exception(error(syntax_error(_), _)) :- !, syntax_error_info(_, Line, Char, Msg), g_read(open_file_stack, OpenFileStack), g_assign(where, OpenFileStack + (Line - Line)), error('syntax error: ~a (char:~d)', [Msg, Char]). exception(error(existence_error(source_sink, File), _)) :- !, error('cannot open file ~a - does not exist', [File]). exception(error(permission_error(open, source_sink, File), _)) :- !, error('cannot open file ~a - permission error', [File]). exception(Err) :- error('exception raised: ~q', [Err]). �������������������gprolog-1.4.5/src/Pl2Wam/pl2wam.pl������������������������������������������������������������������0000644�0001750�0001750�00000035222�13021324543�014753� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : pl2wam.pl * * Descr.: main file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ pl2wam(Arg) :- atom(Arg), Arg \== [], !, % to call easily inder top-level pl2wam([Arg]). pl2wam(LArg) :- catch(pl2wam1(LArg), Err, exception(Err)). pl2wam1(LArg) :- cmd_line_args(LArg, PlFile, WamFile), prolog_file_name(PlFile, PlFile1), g_read(native_code, NativeCode), compile_msg_start(PlFile1, NativeCode), read_file_init(PlFile), emit_code_init(WamFile, PlFile), init_counters, repeat, read_predicate(Pred, N, LSrcCl), add_counter(user_read_file, real_read_file), ( LSrcCl = [] -> % [] at end of file ! ; read_file_error_nb(0), compile_and_emit_pred(NativeCode, Pred, N, LSrcCl), fail ), emit_ensure_linked, read_file_term(InBytes, InLines), emit_code_term(OutBytes, OutLines), read_file_error_nb(ErrNb), ( ErrNb = 0 -> display_counters, compile_msg_end(PlFile1, InBytes, InLines, OutBytes, OutLines) ; format('~N\t~d error(s)~n', [ErrNb]), abort ). compile_and_emit_pred(t, Pred, N, LSrcCl) :- compile_emit_inits(Pred, N, LSrcCl, PlFile, PlLine), compile_lst_clause(LSrcCl, LCompCl), indexing(LCompCl, WamCode), add_counter(user_indexing, real_indexing), emit_code(Pred, N, PlFile, PlLine, WamCode), add_counter(user_wam_emit, real_wam_emit). compile_and_emit_pred(f, Pred, N, LSrcCl) :- compile_emit_inits(Pred, N, LSrcCl, PlFile, PlLine), bc_compile_lst_clause(LSrcCl, LCompCl), bc_emit_code(Pred, N, PlFile, PlLine, LCompCl), add_counter(user_wam_emit, real_wam_emit). compile_emit_inits(Pred, N, LSrcCl, PlFile1, PlLine) :- g_assign(cur_func, Pred), g_assign(cur_arity, N), syntactic_sugar_init_pred(Pred, N), LSrcCl = [[PlFile * _|_] + (PlLine - _) + _|_], absolute_file_name(PlFile, PlFile1). compile_lst_clause([], []). compile_lst_clause([SrcCl|LSrcCl], [cl(_, FirstArg, WamCl)|LCC]) :- compile_clause(SrcCl, FirstArg, WamCl), compile_lst_clause(LSrcCl, LCC). compile_clause(Where + Cl, FirstArg, WamCl) :- g_assign(where, Where), syntactic_sugar(Cl, Head, Body), add_counter(user_syn_sugar, real_syn_sugar), internal_format(Head, Body, Head1, Body1, NbChunk, NbY), add_counter(user_internal, real_internal), code_generation(Head1, Body1, NbChunk, NbY, WamCl), add_counter(user_code_gen, real_code_gen), allocate_registers(WamCl), add_counter(user_reg_alloc, real_reg_alloc), find_first_arg(WamCl, FirstArg), add_counter(user_first_arg, real_first_arg). bc_compile_lst_clause([], []). bc_compile_lst_clause([SrcCl|LSrcCl], [bc(Cl, WamCl)|LCC]) :- SrcCl = _ + Cl, compile_clause(SrcCl, _FirstArg, WamCl), bc_compile_lst_clause(LSrcCl, LCC). compile_msg_start(_, _) :- g_read(compile_msg, f), !. compile_msg_start(PlFile, NativeCode) :- ( NativeCode = t -> Type = 'native code' ; Type = 'byte code' ), format('compiling ~a for ~a...~n', [PlFile, Type]), flush_output. compile_msg_end(_, _, _, _, _) :- g_read(compile_msg, f), !. compile_msg_end(PlFile, _InBytes, InLines, OutBytes, _OutLines) :- real_time(Time), format('~a compiled, ~d lines read - ~d bytes written, ~d ms~n', [PlFile, InLines, OutBytes, Time]). cur_pred(Func, Arity) :- g_read(cur_func, Func), g_read(cur_arity, Arity). cur_pred_without_aux(Func1, Arity1) :- cur_pred(Func, Arity), '$pred_without_aux'(Func, Arity, Func1, Arity1). init_counters :- g_read(statistics, f), !. init_counters :- g_assign(user_read_file, 0), g_assign(real_read_file, 0), g_assign(user_syn_sugar, 0), g_assign(real_syn_sugar, 0), g_assign(user_internal, 0), g_assign(real_internal, 0), g_assign(user_code_gen, 0), g_assign(real_code_gen, 0), g_assign(user_reg_alloc, 0), g_assign(real_reg_alloc, 0), g_assign(user_indexing, 0), g_assign(real_indexing, 0), g_assign(user_first_arg, 0), g_assign(real_first_arg, 0), g_assign(user_wam_emit, 0), g_assign(real_wam_emit, 0), last_times(_, _). add_counter(_, _) :- g_read(statistics, f), !. add_counter(UserCounter, RealCounter) :- last_times(User1, Real1), g_read(UserCounter, User2), g_read(RealCounter, Real2), User is User1 + User2, Real is Real1 + Real2, g_assign(UserCounter, User), g_assign(RealCounter, Real). last_times(User, Real) :- statistics(real_time, [_, Real]), statistics(runtime, [_, User]). display_counters :- g_read(statistics, f), !. display_counters :- g_read(user_read_file, UReadFile), g_read(real_read_file, RReadFile), g_read(user_syn_sugar, USynSugar), g_read(real_syn_sugar, RSynSugar), g_read(user_internal, UInternal), g_read(real_internal, RInternal), g_read(user_code_gen, UCodeGen), g_read(real_code_gen, RCodeGen), g_read(user_reg_alloc, URegAlloc), g_read(real_reg_alloc, RRegAlloc), g_read(user_indexing, UIndexing), g_read(real_indexing, RIndexing), g_read(user_first_arg, UFirstArg), g_read(real_first_arg, RFirstArg), g_read(user_wam_emit, UWamEmit), g_read(real_wam_emit, RWamEmit), U is UReadFile + USynSugar + UInternal + UCodeGen + URegAlloc + UIndexing + UIndexing + UWamEmit, R is RReadFile + RSynSugar + RInternal + RCodeGen + RRegAlloc + RIndexing + RIndexing + RWamEmit, user_time(UTotal), real_time(RTotal), UMisc is UTotal - U, RMisc is RTotal - R, format(' Statistics (in ms) user real~n', []), format(' source reading : %6d %6d~n', [UReadFile, RReadFile]), format(' syntactic sugar : %6d %6d~n', [USynSugar, RSynSugar]), format(' internal format : %6d %6d~n', [UInternal, RInternal]), format(' code generation : %6d %6d~n', [UCodeGen, RCodeGen]), format(' register allocation: %6d %6d~n', [URegAlloc, RRegAlloc]), format(' indexing : %6d %6d~n', [UIndexing, RIndexing]), format(' first arg computing: %6d %6d~n', [UFirstArg, RFirstArg]), format(' code emission : %6d %6d~n', [UWamEmit, RWamEmit]), format(' other : %6d %6d~n', [UMisc, RMisc]), format(' Total : %6d %6d~n', [UTotal, RTotal]). % Command-line options reading cmd_line_args(LArg, PlFile, WamFile) :- g_assign(plfile, ''), g_assign(wamfile, ''), g_assign(native_code, t), g_assign(wam_comment, ''), g_assign(susp_warn, t), g_assign(singl_warn, t), g_assign(redef_error, t), g_assign(foreign_only, f), g_assign(call_c, t), g_assign(inline, t), g_assign(reorder, t), g_assign(reg_opt, 2), g_assign(opt_last_subterm, t), g_assign(keep_void_inst, f), g_assign(fast_math, f), g_assign(statistics, f), g_assign(compile_msg, f), cmd_line_args(LArg), g_read(plfile, PlFile), ( PlFile = '' -> format('no input file~n', []), abort ; true ), g_read(wamfile, WamFile). cmd_line_args([]). cmd_line_args([Arg|LArg]) :- cmd_line_arg1(Arg, LArg, LArg1), !, cmd_line_args(LArg1). cmd_line_arg1('-o', LArg, LArg1) :- cmd_line_arg1('--output', LArg, LArg1). cmd_line_arg1('--output', LArg, LArg1) :- ( LArg = [WamFile|LArg1], sub_atom(WamFile, 0, 1, _, Prefix), Prefix \== (-) ; format('FILE missing after --output option~n', []), abort ), g_read(wamfile, WamFile0), ( WamFile0 = '' -> true ; format('output file already specified (~a)~n', [WamFile0]), abort ), g_assign(wamfile, WamFile). cmd_line_arg1('--pl-state', [File|LArg], LArg) :- read_pl_state_file(File), ( current_prolog_flag(singleton_warning, off) -> g_assign(singl_warn, f) ; true ). cmd_line_arg1('-W', LArg, LArg1) :- cmd_line_arg1('--wam-for-native', LArg, LArg1). cmd_line_arg1('--wam-for-native', LArg, LArg) :- g_assign(native_code, t). cmd_line_arg1('-w', LArg, LArg1) :- cmd_line_arg1('--wam-for-byte-code', LArg, LArg1). cmd_line_arg1('--wam-for-byte-code', LArg, LArg) :- g_assign(native_code, f), g_assign(inline, f), % force --no-inline g_assign(call_c, f). % force --no-call-c cmd_line_arg1('--wam-comment', [Cmt|LArg], LArg) :- g_assign(wam_comment, Cmt). cmd_line_arg1('--no-susp-warn', LArg, LArg) :- g_assign(susp_warn, f). cmd_line_arg1('--no-singl-warn', LArg, LArg) :- g_assign(singl_warn, f). cmd_line_arg1('--no-redef-error', LArg, LArg) :- g_assign(redef_error, f). cmd_line_arg1('--foreign-only', LArg, LArg) :- g_assign(foreign_only, t). cmd_line_arg1('--no-call-c', LArg, LArg) :- g_assign(call_c, f). cmd_line_arg1('--no-inline', LArg, LArg) :- g_assign(inline, f). cmd_line_arg1('--no-reorder', LArg, LArg) :- g_assign(reorder, f). cmd_line_arg1('--no-reg-opt', LArg, LArg) :- g_assign(reg_opt, 0). cmd_line_arg1('--min-reg-opt', LArg, LArg) :- g_assign(reg_opt, 1). cmd_line_arg1('--no-opt-last-subterm', LArg, LArg) :- g_assign(opt_last_subterm, f). cmd_line_arg1('--fast-math', LArg, LArg) :- g_assign(fast_math, t). cmd_line_arg1('--keep-void-inst', LArg, LArg) :- g_assign(keep_void_inst, t). cmd_line_arg1('--statistics', LArg, LArg) :- g_assign(statistics, t). cmd_line_arg1('--compile-msg', LArg, LArg) :- g_assign(compile_msg, t). cmd_line_arg1('--version', LArg, LArg) :- display_copying, stop. cmd_line_arg1('-h', LArg, LArg1) :- cmd_line_arg1('--help', LArg, LArg1). cmd_line_arg1('--help', LArg, LArg) :- ( h(L), write(L), nl, fail ; nl, write('Report bugs to bug-prolog@gnu.org.'), nl, stop ). cmd_line_arg1(Arg, _, _) :- sub_atom(Arg, 0, 1, _, -), format('unknown option ~a - try pl2wam --help~n', [Arg]), abort. cmd_line_arg1(PlFile, LArg, LArg) :- g_read(plfile, PlFile0), ( PlFile0 = '' -> true ; format('input file already specified (~a)~n', [PlFile0]), abort ), g_assign(plfile, PlFile). % Copying display_copying :- prolog_name(Name), prolog_version(Version), prolog_copyright(Copyright), format('Prolog to Wam Compiler (~a) ~a~n', [Name, Version]), format('By Daniel Diaz~n', []), write(Copyright), nl, format('~a comes with ABSOLUTELY NO WARRANTY.~n', [Name]), format('You may redistribute copies of ~a~n', [Name]), format('under the terms of the GNU Lesser General Public License~n', []), format('or of the terms of the GNU General Public License (or both in parallel)~n', []), format('For more information about these matters, see the files named COPYING.~n', []). prolog_name(Name) :- current_prolog_flag(prolog_name, Name). prolog_version(Version) :- current_prolog_flag(prolog_version, Version). prolog_date(Date) :- current_prolog_flag(prolog_date, Date). prolog_copyright(Copyright) :- current_prolog_flag(prolog_copyright, Copyright). % Help h('Usage: pl2wam [OPTION...] FILE'). h(''). h('Options:'). h(' -o FILE, --output FILE set output file name'). h(' -W, --wam-for-native produce a WAM file for native code'). h(' -w, --wam-for-byte-code produce a WAM file for byte-code (force --no-call-c)'). h(' --pl-state FILE read FILE to set the initial Prolog state'). h(' --wam-comment COMMENT emit COMMENT as a comment in the WAM file'). h(' --no-susp-warn do not show warnings for suspicious predicates'). h(' --no-singl-warn do not show warnings for named singleton variables'). h(' --no-redef-error do not show errors for built-in redefinitions'). h(' --foreign-only only compile foreign/1-2 directives'). h(' --no-call-c do not allow the use of fd_tell, ''$call_c'',...'). h(' --no-inline do not inline predicates'). h(' --no-reorder do not reorder predicate arguments'). h(' --no-reg-opt do not optimize registers'). h(' --min-reg-opt minimally optimize registers'). h(' --no-opt-last-subterm do not optimize last subterm compilation'). h(' --fast-math fast mathematical mode (assume integer arithmetics)'). h(' --keep-void-inst keep void instructions in the output file'). h(' --compile-msg print a compile message'). h(' --statistics print statistics information'). h(' --help print this help and exit'). h(' --version print version number and exit'). h(''). h('''user'' can be given as FILE for the standard input/output'). % Starting directive go :- argument_list(LArg), pl2wam(LArg). :- initialization(go). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/pl2wam.wam�����������������������������������������������������������������0000644�0001750�0001750�00000117421�13021356407�015132� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : pl2wam.pl file_name('/home/diaz/GP/src/Pl2Wam/pl2wam.pl'). predicate(user:pl2wam/1,39,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_variable(x(2),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(2)]), put_nil(0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(2),x(0)]), cut(x(1)), put_list(0), unify_local_value(x(2)), unify_nil, execute(pl2wam/1), label(1), trust_me_else_fail, get_variable(x(1),0), put_structure(pl2wam1/1,0), unify_local_value(x(1)), put_structure(exception/1,2), unify_variable(x(1)), put_atom(user,3), put_atom(pl2wam,4), put_integer(1,5), execute('$catch'/6)]). predicate(user:pl2wam1/1,50,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), allocate(13), get_variable(y(0),1), put_variable(y(1),1), put_variable(y(2),2), call(cmd_line_args/3), put_value(y(1),0), put_variable(y(3),1), call(prolog_file_name/2), put_atom(native_code,0), put_variable(y(4),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(3),0), put_value(y(4),1), call(compile_msg_start/2), put_value(y(1),0), call(read_file_init/1), put_value(y(2),0), put_value(y(1),1), call(emit_code_init/2), call(init_counters/0), call(repeat/0), put_variable(y(5),0), put_variable(y(6),1), put_variable(y(7),2), call(read_predicate/3), put_atom(user_read_file,0), put_atom(real_read_file,1), call(add_counter/2), put_value(y(7),0), put_value(y(0),1), put_value(y(4),2), put_value(y(5),3), put_value(y(6),4), call('$pl2wam1/1_$aux1'/5), call(emit_ensure_linked/0), put_variable(y(8),0), put_variable(y(9),1), call(read_file_term/2), put_variable(y(10),0), put_variable(y(11),1), call(emit_code_term/2), put_variable(y(12),0), call(read_file_error_nb/1), put_unsafe_value(y(12),0), put_unsafe_value(y(3),1), put_unsafe_value(y(8),2), put_unsafe_value(y(9),3), put_unsafe_value(y(10),4), put_unsafe_value(y(11),5), deallocate, execute('$pl2wam1/1_$aux2'/6)]). predicate(user:'$pl2wam1/1_$aux2'/6,50,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_integer(0,0), cut(x(6)), call(display_counters/0), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute(compile_msg_end/5), label(1), trust_me_else_fail, allocate(0), put_list(1), unify_local_value(x(0)), unify_nil, put_atom('~N\t~d error(s)~n',0), call(format/2), deallocate, execute(abort/0)]). predicate(user:'$pl2wam1/1_$aux1'/5,50,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_nil(0), cut(x(5)), cut(x(1)), proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), put_integer(0,0), call(read_file_error_nb/1), put_value(y(1),0), put_value(y(2),1), put_value(y(3),2), put_value(y(0),3), call(compile_and_emit_pred/4), fail]). predicate(user:compile_and_emit_pred/4,82,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(t,3),(f,5)]), label(2), try_me_else(4), label(3), allocate(7), get_atom(t,0), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_variable(y(3),3), put_variable(y(4),4), call(compile_emit_inits/5), put_value(y(2),0), put_variable(y(5),1), call(compile_lst_clause/2), put_value(y(5),0), put_variable(y(6),1), call(indexing/2), put_atom(user_indexing,0), put_atom(real_indexing,1), call(add_counter/2), put_value(y(0),0), put_value(y(1),1), put_value(y(3),2), put_value(y(4),3), put_value(y(6),4), call(emit_code/5), put_atom(user_wam_emit,0), put_atom(real_wam_emit,1), deallocate, execute(add_counter/2), label(4), trust_me_else_fail, label(5), allocate(6), get_atom(f,0), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_variable(y(3),3), put_variable(y(4),4), call(compile_emit_inits/5), put_value(y(2),0), put_variable(y(5),1), call(bc_compile_lst_clause/2), put_value(y(0),0), put_value(y(1),1), put_value(y(3),2), put_value(y(4),3), put_value(y(5),4), call(bc_emit_code/5), put_atom(user_wam_emit,0), put_atom(real_wam_emit,1), deallocate, execute(add_counter/2)]). predicate(user:compile_emit_inits/5,99,static,private,monofile,global,[ allocate(3), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), put_atom(cur_func,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(2),x(0)]), put_atom(cur_arity,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(2),x(1)]), call(syntactic_sugar_init_pred/2), put_value(y(0),0), get_list(0), unify_variable(x(0)), unify_void(1), get_structure((+)/2,0), unify_variable(x(0)), unify_void(1), get_structure((+)/2,0), unify_variable(x(0)), unify_structure((-)/2), unify_local_value(y(2)), unify_void(1), get_list(0), unify_variable(x(0)), unify_void(1), get_structure((*)/2,0), unify_variable(x(0)), unify_void(1), put_value(y(1),1), deallocate, execute(absolute_file_name/2)]). predicate(user:compile_lst_clause/2,109,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), get_structure(cl/3,1), unify_void(1), unify_variable(x(1)), unify_variable(x(2)), call(compile_clause/3), put_value(y(0),0), put_value(y(1),1), deallocate, execute(compile_lst_clause/2)]). predicate(user:compile_clause/3,118,static,private,monofile,global,[ allocate(8), get_variable(y(0),1), get_variable(y(1),2), get_structure((+)/2,0), unify_variable(x(2)), unify_variable(x(0)), put_atom(where,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_variable(y(2),1), put_variable(y(3),2), call(syntactic_sugar/3), put_atom(user_syn_sugar,0), put_atom(real_syn_sugar,1), call(add_counter/2), put_value(y(2),0), put_value(y(3),1), put_variable(y(4),2), put_variable(y(5),3), put_variable(y(6),4), put_variable(y(7),5), call(internal_format/6), put_atom(user_internal,0), put_atom(real_internal,1), call(add_counter/2), put_value(y(4),0), put_value(y(5),1), put_value(y(6),2), put_value(y(7),3), put_value(y(1),4), call(code_generation/5), put_atom(user_code_gen,0), put_atom(real_code_gen,1), call(add_counter/2), put_value(y(1),0), call(allocate_registers/1), put_atom(user_reg_alloc,0), put_atom(real_reg_alloc,1), call(add_counter/2), put_value(y(1),0), put_value(y(0),1), call(find_first_arg/2), put_atom(user_first_arg,0), put_atom(real_first_arg,1), deallocate, execute(add_counter/2)]). predicate(user:bc_compile_lst_clause/2,134,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), get_structure(bc/2,1), unify_variable(x(1)), unify_variable(x(2)), get_structure((+)/2,0), unify_void(1), unify_value(x(1)), put_void(1), call(compile_clause/3), put_value(y(0),0), put_value(y(1),1), deallocate, execute(bc_compile_lst_clause/2)]). predicate(user:compile_msg_start/2,143,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(compile_msg,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), proceed, label(1), trust_me_else_fail, allocate(2), get_variable(y(0),0), put_value(x(1),0), put_variable(y(1),1), call('$compile_msg_start/2_$aux1'/2), put_atom('compiling ~a for ~a...~n',0), put_list(1), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_nil, call(format/2), deallocate, execute(flush_output/0)]). predicate(user:'$compile_msg_start/2_$aux1'/2,146,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(t,0), cut(x(2)), get_atom('native code',1), proceed, label(1), trust_me_else_fail, get_atom('byte code',1), proceed]). predicate(user:compile_msg_end/5,157,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), put_atom(compile_msg,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), cut(x(5)), proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), put_variable(y(3),0), call(real_time/1), put_atom('~a compiled, ~d lines read - ~d bytes written, ~d ms~n',0), put_list(1), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_list, unify_local_value(y(2)), unify_list, unify_local_value(y(3)), unify_nil, deallocate, execute(format/2)]). predicate(user:cur_pred/2,167,static,private,monofile,global,[ put_atom(cur_func,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(0)]), put_atom(cur_arity,0), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(user:cur_pred_without_aux/2,172,static,private,monofile,global,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), put_variable(y(2),0), put_variable(y(3),1), call(cur_pred/2), put_unsafe_value(y(2),0), put_unsafe_value(y(3),1), put_value(y(0),2), put_value(y(1),3), deallocate, execute('$pred_without_aux'/4)]). predicate(user:init_counters/0,179,static,private,monofile,global,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), put_atom(statistics,1), put_atom(f,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), cut(x(0)), proceed, label(1), trust_me_else_fail, put_atom(user_read_file,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_read_file,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_syn_sugar,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_syn_sugar,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_internal,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_internal,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_code_gen,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_code_gen,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_reg_alloc,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_reg_alloc,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_indexing,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_indexing,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_first_arg,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_first_arg,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(user_wam_emit,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(real_wam_emit,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_void(0), put_void(1), execute(last_times/2)]). predicate(user:add_counter/2,204,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(statistics,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),0), get_variable(y(1),1), put_variable(y(2),0), put_variable(y(3),1), call(last_times/2), put_value(y(0),0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(1),0), put_variable(x(1),3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(3)]), math_fast_load_value(y(2),0), math_fast_load_value(x(2),2), call_c('Pl_Fct_Fast_Add',[fast_call,x(2)],[x(0),x(2)]), math_fast_load_value(y(3),0), math_fast_load_value(x(1),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(1)],[x(0),x(1)]), put_value(y(0),0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(2)]), put_value(y(1),0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed]). predicate(user:last_times/2,219,static,private,monofile,global,[ allocate(1), get_variable(y(0),0), get_variable(x(0),1), put_list(1), unify_void(1), unify_list, unify_local_value(x(0)), unify_nil, put_atom(real_time,0), call(statistics/2), put_atom(runtime,0), put_list(1), unify_void(1), unify_list, unify_local_value(y(0)), unify_nil, deallocate, execute(statistics/2)]). predicate(user:display_counters/0,226,static,private,monofile,global,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), put_atom(statistics,1), put_atom(f,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), cut(x(0)), proceed, label(1), trust_me_else_fail, allocate(22), put_atom(user_read_file,0), put_variable(y(0),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_read_file,0), put_variable(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_syn_sugar,0), put_variable(y(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_syn_sugar,0), put_variable(y(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_internal,0), put_variable(y(4),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_internal,0), put_variable(y(5),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_code_gen,0), put_variable(y(6),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_code_gen,0), put_variable(y(7),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_reg_alloc,0), put_variable(y(8),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_reg_alloc,0), put_variable(y(9),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_indexing,0), put_variable(y(10),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_indexing,0), put_variable(y(11),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_first_arg,0), put_variable(y(12),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_first_arg,0), put_variable(y(13),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(user_wam_emit,0), put_variable(y(14),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(real_wam_emit,0), put_variable(y(15),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(0),0), math_fast_load_value(y(2),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(4),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(6),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(8),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(10),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(10),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(14),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), get_variable(y(16),0), math_fast_load_value(y(1),0), math_fast_load_value(y(3),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(5),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(7),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(9),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(11),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(11),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(15),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(0)],[x(0),x(1)]), get_variable(y(17),0), put_variable(y(18),0), call(user_time/1), put_variable(y(19),0), call(real_time/1), math_fast_load_value(y(18),0), math_fast_load_value(y(16),1), call_c('Pl_Fct_Fast_Sub',[fast_call,x(0)],[x(0),x(1)]), get_variable(y(20),0), math_fast_load_value(y(19),0), math_fast_load_value(y(17),1), call_c('Pl_Fct_Fast_Sub',[fast_call,x(0)],[x(0),x(1)]), get_variable(y(21),0), put_atom(' Statistics (in ms) user real~n',0), put_nil(1), call(format/2), put_atom(' source reading : %6d %6d~n',0), put_list(1), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_nil, call(format/2), put_atom(' syntactic sugar : %6d %6d~n',0), put_list(1), unify_local_value(y(2)), unify_list, unify_local_value(y(3)), unify_nil, call(format/2), put_atom(' internal format : %6d %6d~n',0), put_list(1), unify_local_value(y(4)), unify_list, unify_local_value(y(5)), unify_nil, call(format/2), put_atom(' code generation : %6d %6d~n',0), put_list(1), unify_local_value(y(6)), unify_list, unify_local_value(y(7)), unify_nil, call(format/2), put_atom(' register allocation: %6d %6d~n',0), put_list(1), unify_local_value(y(8)), unify_list, unify_local_value(y(9)), unify_nil, call(format/2), put_atom(' indexing : %6d %6d~n',0), put_list(1), unify_local_value(y(10)), unify_list, unify_local_value(y(11)), unify_nil, call(format/2), put_atom(' first arg computing: %6d %6d~n',0), put_list(1), unify_local_value(y(12)), unify_list, unify_local_value(y(13)), unify_nil, call(format/2), put_atom(' code emission : %6d %6d~n',0), put_list(1), unify_local_value(y(14)), unify_list, unify_local_value(y(15)), unify_nil, call(format/2), put_atom(' other : %6d %6d~n',0), put_list(1), unify_local_value(y(20)), unify_list, unify_local_value(y(21)), unify_nil, call(format/2), put_atom(' Total : %6d %6d~n',0), put_list(1), unify_local_value(y(18)), unify_list, unify_local_value(y(19)), unify_nil, deallocate, execute(format/2)]). predicate(user:cmd_line_args/3,269,static,private,monofile,global,[ allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_atom(plfile,1), put_atom('',2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(wamfile,1), put_atom('',2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(native_code,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(wam_comment,1), put_atom('',2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(susp_warn,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(singl_warn,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(redef_error,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(foreign_only,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(call_c,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(inline,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(reorder,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(reg_opt,1), put_integer(2,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(opt_last_subterm,1), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(keep_void_inst,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(fast_math,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(statistics,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(compile_msg,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), call(cmd_line_args/1), put_atom(plfile,0), put_value(y(0),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), call('$cmd_line_args/3_$aux1'/1), put_atom(wamfile,0), put_value(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed]). predicate(user:'$cmd_line_args/3_$aux1'/1,269,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(0), get_atom('',0), cut(x(1)), put_atom('no input file~n',0), put_nil(1), call(format/2), deallocate, execute(abort/0), label(1), trust_me_else_fail, proceed]). predicate(user:cmd_line_args/1,299,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(x(2)), get_variable(y(0),1), put_value(x(2),1), put_variable(y(1),2), call(cmd_line_arg1/3), cut(y(0)), put_unsafe_value(y(1),0), deallocate, execute(cmd_line_args/1)]). predicate(user:cmd_line_arg1/3,306,static,private,monofile,global,[ try_me_else(52), switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([('-o',3),('--output',5),('--pl-state',7),('-W',9),('--wam-for-native',11),('-w',13),('--wam-for-byte-code',15),('--wam-comment',17),('--no-susp-warn',19),('--no-singl-warn',21),('--no-redef-error',23),('--foreign-only',25),('--no-call-c',27),('--no-inline',29),('--no-reorder',31),('--no-reg-opt',33),('--min-reg-opt',35),('--no-opt-last-subterm',37),('--fast-math',39),('--keep-void-inst',41),('--statistics',43),('--compile-msg',45),('--version',47),('-h',49),('--help',51)]), label(2), try_me_else(4), label(3), get_atom('-o',0), put_atom('--output',0), execute(cmd_line_arg1/3), label(4), retry_me_else(6), label(5), allocate(1), get_atom('--output',0), put_value(x(1),0), put_variable(y(0),1), call('$cmd_line_arg1/3_$aux1'/3), put_atom(wamfile,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call('$cmd_line_arg1/3_$aux2'/1), put_atom(wamfile,0), put_unsafe_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(6), retry_me_else(8), label(7), allocate(0), get_atom('--pl-state',0), get_list(1), unify_variable(x(0)), unify_local_value(x(2)), call(read_pl_state_file/1), deallocate, execute('$cmd_line_arg1/3_$aux3'/0), label(8), retry_me_else(10), label(9), get_atom('-W',0), put_atom('--wam-for-native',0), execute(cmd_line_arg1/3), label(10), retry_me_else(12), label(11), get_atom('--wam-for-native',0), get_value(x(2),1), put_atom(native_code,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(12), retry_me_else(14), label(13), get_atom('-w',0), put_atom('--wam-for-byte-code',0), execute(cmd_line_arg1/3), label(14), retry_me_else(16), label(15), get_atom('--wam-for-byte-code',0), get_value(x(2),1), put_atom(native_code,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(inline,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(call_c,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(16), retry_me_else(18), label(17), get_atom('--wam-comment',0), get_list(1), unify_variable(x(1)), unify_local_value(x(2)), put_atom(wam_comment,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(18), retry_me_else(20), label(19), get_atom('--no-susp-warn',0), get_value(x(2),1), put_atom(susp_warn,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(20), retry_me_else(22), label(21), get_atom('--no-singl-warn',0), get_value(x(2),1), put_atom(singl_warn,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(22), retry_me_else(24), label(23), get_atom('--no-redef-error',0), get_value(x(2),1), put_atom(redef_error,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(24), retry_me_else(26), label(25), get_atom('--foreign-only',0), get_value(x(2),1), put_atom(foreign_only,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(26), retry_me_else(28), label(27), get_atom('--no-call-c',0), get_value(x(2),1), put_atom(call_c,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(28), retry_me_else(30), label(29), get_atom('--no-inline',0), get_value(x(2),1), put_atom(inline,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(30), retry_me_else(32), label(31), get_atom('--no-reorder',0), get_value(x(2),1), put_atom(reorder,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(32), retry_me_else(34), label(33), get_atom('--no-reg-opt',0), get_value(x(2),1), put_atom(reg_opt,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(34), retry_me_else(36), label(35), get_atom('--min-reg-opt',0), get_value(x(2),1), put_atom(reg_opt,0), put_integer(1,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(36), retry_me_else(38), label(37), get_atom('--no-opt-last-subterm',0), get_value(x(2),1), put_atom(opt_last_subterm,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(38), retry_me_else(40), label(39), get_atom('--fast-math',0), get_value(x(2),1), put_atom(fast_math,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(40), retry_me_else(42), label(41), get_atom('--keep-void-inst',0), get_value(x(2),1), put_atom(keep_void_inst,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(42), retry_me_else(44), label(43), get_atom('--statistics',0), get_value(x(2),1), put_atom(statistics,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(44), retry_me_else(46), label(45), get_atom('--compile-msg',0), get_value(x(2),1), put_atom(compile_msg,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(46), retry_me_else(48), label(47), allocate(0), get_atom('--version',0), get_value(x(2),1), call(display_copying/0), deallocate, execute(stop/0), label(48), retry_me_else(50), label(49), get_atom('-h',0), put_atom('--help',0), execute(cmd_line_arg1/3), label(50), trust_me_else_fail, label(51), get_atom('--help',0), get_value(x(2),1), execute('$cmd_line_arg1/3_$aux4'/0), label(52), retry_me_else(53), allocate(1), get_variable(y(0),0), put_value(y(0),0), put_integer(0,1), put_integer(1,2), put_void(3), put_atom(-,4), call(sub_atom/5), put_atom('unknown option ~a - try pl2wam --help~n',0), put_list(1), unify_local_value(y(0)), unify_nil, call(format/2), deallocate, execute(abort/0), label(53), trust_me_else_fail, allocate(1), get_variable(y(0),0), get_value(x(2),1), put_atom(plfile,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call('$cmd_line_arg1/3_$aux5'/1), put_atom(plfile,0), put_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed]). predicate(user:'$cmd_line_arg1/3_$aux5'/1,413,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_atom('',0), cut(x(1)), proceed, label(1), trust_me_else_fail, allocate(0), put_list(1), unify_local_value(x(0)), unify_nil, put_atom('input file already specified (~a)~n',0), call(format/2), deallocate, execute(abort/0)]). predicate(user:'$cmd_line_arg1/3_$aux4'/0,397,static,private,monofile,local,[ try_me_else(1), allocate(1), put_variable(y(0),0), call(h/1), put_value(y(0),0), call(write/1), call(nl/0), fail, label(1), trust_me_else_fail, allocate(0), call(nl/0), put_atom('Report bugs to bug-prolog@gnu.org.',0), call(write/1), call(nl/0), deallocate, execute(stop/0)]). predicate(user:'$cmd_line_arg1/3_$aux3'/0,324,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), allocate(1), get_variable(y(0),0), put_atom(singleton_warning,0), put_atom(off,1), call(current_prolog_flag/2), cut(y(0)), put_atom(singl_warn,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(1), trust_me_else_fail, proceed]). predicate(user:'$cmd_line_arg1/3_$aux2'/1,309,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_atom('',0), cut(x(1)), proceed, label(1), trust_me_else_fail, allocate(0), put_list(1), unify_local_value(x(0)), unify_nil, put_atom('output file already specified (~a)~n',0), call(format/2), deallocate, execute(abort/0)]). predicate(user:'$cmd_line_arg1/3_$aux1'/3,309,static,private,monofile,local,[ try_me_else(1), allocate(1), get_list(0), unify_local_value(x(1)), unify_local_value(x(2)), put_value(x(1),0), put_integer(0,1), put_integer(1,2), put_void(3), put_variable(y(0),4), call(sub_atom/5), put_unsafe_value(y(0),0), put_atom(-,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed, label(1), trust_me_else_fail, allocate(0), put_atom('FILE missing after --output option~n',0), put_nil(1), call(format/2), deallocate, execute(abort/0)]). predicate(user:display_copying/0,427,static,private,monofile,global,[ allocate(3), put_variable(y(0),0), call(prolog_name/1), put_variable(y(1),0), call(prolog_version/1), put_variable(y(2),0), call(prolog_copyright/1), put_atom('Prolog to Wam Compiler (~a) ~a~n',0), put_list(1), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_nil, call(format/2), put_atom('By Daniel Diaz~n',0), put_nil(1), call(format/2), put_value(y(2),0), call(write/1), call(nl/0), put_atom('~a comes with ABSOLUTELY NO WARRANTY.~n',0), put_list(1), unify_local_value(y(0)), unify_nil, call(format/2), put_atom('You may redistribute copies of ~a~n',0), put_list(1), unify_local_value(y(0)), unify_nil, call(format/2), put_atom('under the terms of the GNU Lesser General Public License~n',0), put_nil(1), call(format/2), put_atom('or of the terms of the GNU General Public License (or both in parallel)~n',0), put_nil(1), call(format/2), put_atom('For more information about these matters, see the files named COPYING.~n',0), put_nil(1), deallocate, execute(format/2)]). predicate(user:prolog_name/1,444,static,private,monofile,global,[ put_value(x(0),1), put_atom(prolog_name,0), execute(current_prolog_flag/2)]). predicate(user:prolog_version/1,447,static,private,monofile,global,[ put_value(x(0),1), put_atom(prolog_version,0), execute(current_prolog_flag/2)]). predicate(user:prolog_date/1,450,static,private,monofile,global,[ put_value(x(0),1), put_atom(prolog_date,0), execute(current_prolog_flag/2)]). predicate(user:prolog_copyright/1,453,static,private,monofile,global,[ put_value(x(0),1), put_atom(prolog_copyright,0), execute(current_prolog_flag/2)]). predicate(user:h/1,461,static,private,monofile,global,[ switch_on_term(3,1,fail,fail,fail), label(1), switch_on_atom([('Usage: pl2wam [OPTION...] FILE',4),('',2),('Options:',8),(' -o FILE, --output FILE set output file name',10),(' -W, --wam-for-native produce a WAM file for native code',12),(' -w, --wam-for-byte-code produce a WAM file for byte-code (force --no-call-c)',14),(' --pl-state FILE read FILE to set the initial Prolog state',16),(' --wam-comment COMMENT emit COMMENT as a comment in the WAM file',18),(' --no-susp-warn do not show warnings for suspicious predicates',20),(' --no-singl-warn do not show warnings for named singleton variables',22),(' --no-redef-error do not show errors for built-in redefinitions',24),(' --foreign-only only compile foreign/1-2 directives',26),(' --no-call-c do not allow the use of fd_tell, ''$call_c'',...',28),(' --no-inline do not inline predicates',30),(' --no-reorder do not reorder predicate arguments',32),(' --no-reg-opt do not optimize registers',34),(' --min-reg-opt minimally optimize registers',36),(' --no-opt-last-subterm do not optimize last subterm compilation',38),(' --fast-math fast mathematical mode (assume integer arithmetics)',40),(' --keep-void-inst keep void instructions in the output file',42),(' --compile-msg print a compile message',44),(' --statistics print statistics information',46),(' --help print this help and exit',48),(' --version print version number and exit',50),('''user'' can be given as FILE for the standard input/output',54)]), label(2), try(6), trust(52), label(3), try_me_else(5), label(4), get_atom('Usage: pl2wam [OPTION...] FILE',0), proceed, label(5), retry_me_else(7), label(6), get_atom('',0), proceed, label(7), retry_me_else(9), label(8), get_atom('Options:',0), proceed, label(9), retry_me_else(11), label(10), get_atom(' -o FILE, --output FILE set output file name',0), proceed, label(11), retry_me_else(13), label(12), get_atom(' -W, --wam-for-native produce a WAM file for native code',0), proceed, label(13), retry_me_else(15), label(14), get_atom(' -w, --wam-for-byte-code produce a WAM file for byte-code (force --no-call-c)',0), proceed, label(15), retry_me_else(17), label(16), get_atom(' --pl-state FILE read FILE to set the initial Prolog state',0), proceed, label(17), retry_me_else(19), label(18), get_atom(' --wam-comment COMMENT emit COMMENT as a comment in the WAM file',0), proceed, label(19), retry_me_else(21), label(20), get_atom(' --no-susp-warn do not show warnings for suspicious predicates',0), proceed, label(21), retry_me_else(23), label(22), get_atom(' --no-singl-warn do not show warnings for named singleton variables',0), proceed, label(23), retry_me_else(25), label(24), get_atom(' --no-redef-error do not show errors for built-in redefinitions',0), proceed, label(25), retry_me_else(27), label(26), get_atom(' --foreign-only only compile foreign/1-2 directives',0), proceed, label(27), retry_me_else(29), label(28), get_atom(' --no-call-c do not allow the use of fd_tell, ''$call_c'',...',0), proceed, label(29), retry_me_else(31), label(30), get_atom(' --no-inline do not inline predicates',0), proceed, label(31), retry_me_else(33), label(32), get_atom(' --no-reorder do not reorder predicate arguments',0), proceed, label(33), retry_me_else(35), label(34), get_atom(' --no-reg-opt do not optimize registers',0), proceed, label(35), retry_me_else(37), label(36), get_atom(' --min-reg-opt minimally optimize registers',0), proceed, label(37), retry_me_else(39), label(38), get_atom(' --no-opt-last-subterm do not optimize last subterm compilation',0), proceed, label(39), retry_me_else(41), label(40), get_atom(' --fast-math fast mathematical mode (assume integer arithmetics)',0), proceed, label(41), retry_me_else(43), label(42), get_atom(' --keep-void-inst keep void instructions in the output file',0), proceed, label(43), retry_me_else(45), label(44), get_atom(' --compile-msg print a compile message',0), proceed, label(45), retry_me_else(47), label(46), get_atom(' --statistics print statistics information',0), proceed, label(47), retry_me_else(49), label(48), get_atom(' --help print this help and exit',0), proceed, label(49), retry_me_else(51), label(50), get_atom(' --version print version number and exit',0), proceed, label(51), retry_me_else(53), label(52), get_atom('',0), proceed, label(53), trust_me_else_fail, label(54), get_atom('''user'' can be given as FILE for the standard input/output',0), proceed]). predicate(user:go/0,493,static,private,monofile,global,[ allocate(1), put_variable(y(0),0), call(argument_list/1), put_unsafe_value(y(0),0), deallocate, execute(pl2wam/1)]). directive(497,user,[ execute(go/0)]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/yaplib.pl������������������������������������������������������������������0000644�0001750�0001750�00000001155�13021324543�015027� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� prolog_name('YAP Prolog'). prolog_version('4.3.12'). prolog_date('2000'). prolog_copyright(''). g_assign(Var, Value) :- bb_put(Var, Value). g_read(Var, Value) :- ( bb_get(Var, Value1) ; Value1 = 0 ), !, Value = Value1. argument_list([]). reverse([], []). reverse([H|T], L) :- reverse1(T, L, [H]). reverse1([], L, L). reverse1([H|T], L, L1) :- reverse1(T, L, [H|L1]). append([], L, L). append([X|L1], L2, [X|L3]) :- append(L1, L2, L3). % execution go_other :- argument_list(L), go_other1(L). go_other1([]) :- !. go_other1(L) :- pl2wam(L), halt. :- initialization(go_other). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/ciaolib.pl�����������������������������������������������������������������0000644�0001750�0001750�00000002004�13021324543�015143� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� :- use_module(library(format)). :- use_module(library(sort)). :- use_module(library(lists)). :- use_module(library(prolog_sys), [statistics / 2]). prolog_name('CIAO Prolog'). prolog_version('1.6'). prolog_date('2000'). prolog_copyright(''). expand_term(X, X). /* g_assign(Var, Value) :- bb_put(Var, Value). g_read(Var, Value) :- ( bb_get(Var, Value1) ; Value1=0 ), !, Value=Value1. */ g_assign(Var, Value) :- ( retract(gvar(Var, _)) ; true ), !, asserta(gvar(Var, Value)). g_read(Var, Value) :- ( gvar(Var, Value1) ; Value1 = 0 ), !, Value = Value1. argument_list(LArgs) :- current_prolog_flag(argv, LArgs). /* reverse([], []). reverse([H|T], L) :- reverse1(T, L, [H]). reverse1([], L, L). reverse1([H|T], L, L1) :- reverse1(T, L, [H|L1]). append([], L, L). append([X|L1], L2, [X|L3]) :- append(L1, L2, L3). */ % execution go_other :- argument_list(L), go_other1(L). go_other1([]) :- !. go_other1(L) :- pl2wam(L), halt. :- initialization(go_other). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/indexing.pl����������������������������������������������������������������0000644�0001750�0001750�00000036377�13021324543�015372� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : indexing.pl * * Descr.: indexing code generation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * Level 1: * * * * The clauses C1,...,Cn of a predicate Pred are split into groups * * G0,...,Gm so that each group Gi: * * * * a) contains only one clause whose 1st arg is a variable. * * b) contains only clauses whose 1st arg is not a variable. * * * * The following code is then produced: * * * * L0: try_me_else(L1) * * <code for G0> * * * * L1: retry_me_else(L2) * * <code for G1> * * : * * : * * Lm: trust_me_else_fail * * <code for Gm> * * * * Level 2: * * * * For a group Gi whose type is a), the <code for Gi> only contains the * * code produced for the associated Ck clause. * * For a group Gi whose type is b), the <code for Gi> contains indexing * * instructions for the level 2 to discriminate between atoms, integers * * lists and structures as follows: * * * * switch_on_term(LabVar,LabAtm,LabInt,LabLst,LabStc) * * * * LabFail: fail if there is a LabXxx = LabFail * * * * LabAtm : switch_on_atom(N,[(atm1,LabAtm1),...(atmN,LabAtmN)]) \ * * | * * LabAtmj: try(Adj1) \ if more than 1 clause has | * * retry(Adj2) if more than 2 | atmj as 1st arg, | * * : | else LabAtmj = Adj1 | * * trust(Adjk) / | * * if there are atms, else LabAtm=LabFail/ * * idem for switch_on_integer * * * * LabLst : try(Adj1) \ if more than 1 clause has | * * retry(Adj2) if more than 2 | [_|_] as 1st arg, | * * : | else LabLst = Adj1 | * * trust(Adjk) / | * * if there are lsts, else LabLst=LabFail/ * * * * LabStc : switch_on_structure(N,[(stc1,LabStc1),...(stcN,LabStcN)]) \ * * | * * LabStcj: try(Adj1) \ if more than 1 clause has | * * retry(Adj2) if more than 2 | stcj as 1st arg, | * * : | else LabStcj = Adj1 | * * trust(Adjk) / | * * if there are stcs, else LabStc=LabFail/ * * * * LabVar: try_me_else(LabVar2) if there are more than 1 clause in Gi, * * Ad1: <code for clause 1> else LabVar = Ad1 * * * * LabVar2: retry_me_else(LabVar3) * * Ad2: <code for clause 2> * * : * * : * * LabVarp: trust_me_else_fail * * Adp: <code for clause p> * * * * LCC: [cl(Ad,FirstArg,WamCl), ...] list of compiled clauses for Pred. * * * * Ad : will contain (in level 2) the label associated to WamCl * * (initially Ad is an unbound variable). * * FirstArg: the first argument of the source clause. * * WamCl : [wam_inst, ...] clause wam code. * * * * look_for_var partitions LCC in LCCBefore, CCVar and LCCAfter and detects* * the current case: * * * * 1...) a variables has been found (thus level 1), sub-cases: * * 11) LCCBefore<>[] and LCCAfter<>[] 12) LCCBefore<>[] and LCCAfter=[]* * 13) LCCBefore= [] and LCCAfter<>[] 14) LCCBefore= [] and LCCAfter=[]* * * * 2) no variables (thus level 2). * * * * other used variables: * * * * Lev1: has any try/retry/trust_me_else been generated for level 1 (t/f)? * * Atm : [a(atm,[Ad, ...]), ...] * * Int : [a(int,[Ad, ...]), ...] * * Lst : [Ad, ...] * * Stc : [a(f/n,[Ad, ...]), ...] * * List: Atm, Int, or Stc for general processings * * * * Each label issued from the indexing phase is first referenced and later * * defined. * *-------------------------------------------------------------------------*/ indexing(LCC, WamCode1) :- indexing1(LCC, f, _, [_|WamCode]), % ignore the unused label(0) cur_pred(Pred, N), ( test_pred_info(cut, Pred, N) -> N1 is N + 1, WamCode1 = [pragma_arity(N1), get_current_choice(x(N))|WamCode] ; WamCode1 = WamCode ), allocate_labels(WamCode1, 1, _). indexing1(LCC, Lev1, Lab, [label(Lab)|WamCode]) :- look_for_var(LCC, Case, LCCBefore, CCVar, LCCAfter), mk_indexing(Case, LCCBefore, CCVar, LCCAfter, Lev1, WamCode), !. look_for_var([], 2, [], _, []). look_for_var([cl(Ad, var, WamCl)|LCC], Case, [], cl(Ad, var, WamCl), LCC) :- !, ( LCC = [] -> Case = 14 ; Case = 13 ). look_for_var([CC|LCC], Case1, [CC|LCCBefore], CCVar, LCCAfter) :- look_for_var(LCC, Case, LCCBefore, CCVar, LCCAfter), ( Case = 13 -> Case1 = 11 ; Case = 14 -> Case1 = 12 ; Case1 = Case ). mk_indexing(11, LCCBefore, cl(_, _, WamCl), LCCAfter, Lev1, WamCode) :- ( Lev1 = f -> TmRmTm = try_me_else(Lab) ; TmRmTm = retry_me_else(Lab) ), mk_indexing(2, LCCBefore, _, _, f, WamBefore), indexing1(LCCAfter, t, Lab1, WamAfter), WamCode = [TmRmTm, WamBefore, label(Lab), retry_me_else(Lab1), WamCl|WamAfter]. mk_indexing(12, LCCBefore, cl(_, _, WamCl), _, Lev1, WamCode) :- ( Lev1 = f -> TmRmTm = try_me_else(Lab) ; TmRmTm = retry_me_else(Lab) ), mk_indexing(2, LCCBefore, _, _, f, WamBefore), WamCode = [TmRmTm, WamBefore, label(Lab), trust_me_else_fail|WamCl]. mk_indexing(13, _, cl(_, _, WamCl), LCCAfter, Lev1, WamCode) :- ( Lev1 = f -> TmRmTm = try_me_else(Lab) ; TmRmTm = retry_me_else(Lab) ), indexing1(LCCAfter, t, Lab, WamAfter), WamCode = [TmRmTm, WamCl|WamAfter]. mk_indexing(14, _, cl(_, _, WamCl), _, Lev1, WamCode) :- ( Lev1 = f -> WamCode = WamCl ; WamCode = [trust_me_else_fail|WamCl] ). mk_indexing(2, LCC, _, _, Lev1, WamCode) :- ( Lev1 = f -> WamCode = WamCode1 ; WamCode = [trust_me_else_fail|WamCode1] ), ( LCC = [_] -> % no switch_on_term for only one clause WamCode2 = [_|WamCode2Rest], % remove useless label WamCode1 = WamCode2Rest ; WamCode1 = [switch_on_term(LabVar, LabAtm, LabInt, LabLst, LabStc)|WamCode2] ), WamCode2 = WamSwtAtm, split(LCC, Atm, Int, Lst, Stc), !, gen_switch(Atm, switch_on_atom, LabAtm, WamSwtInt, WamSwtAtm), gen_switch(Int, switch_on_integer, LabInt, WamLst, WamSwtInt), gen_list(Lst, LabLst, WamSwtStc, WamLst), gen_switch(Stc, switch_on_structure, LabStc, WamCode3, WamSwtStc), gen_insts(LCC, LabVar, WamCode3). split(LCC, Atm1, Int1, Lst, Stc1) :- split1(LCC, [], [], a(End, End), [], Atm, Int, a([], Lst), Stc), terminate_list(Atm, Atm1), terminate_list(Int, Int1), terminate_list(Stc, Stc1). split1([], Atm, Int, Lst, Stc, Atm, Int, Lst, Stc). split1([cl(Ad, FirstArg, _)|LCC], Atm, Int, Lst, Stc, Atm2, Int2, Lst2, Stc2) :- split2(FirstArg, Ad, Atm, Int, Lst, Stc, Atm1, Int1, Lst1, Stc1), split1(LCC, Atm1, Int1, Lst1, Stc1, Atm2, Int2, Lst2, Stc2). split2(atm(A), Ad, Atm, Int, Lst, Stc, Atm1, Int, Lst, Stc) :- add_to_list(Atm, A, Ad, Atm1). split2(int(N), Ad, Atm, Int, Lst, Stc, Atm, Int1, Lst, Stc) :- add_to_list(Int, N, Ad, Int1). split2(lst, Ad, Atm, Int, a([Ad|End], LAd), Stc, Atm, Int, a(End, LAd), Stc). split2(stc(F, N), Ad, Atm, Int, Lst, Stc, Atm, Int, Lst, Stc1) :- add_to_list(Stc, F / N, Ad, Stc1). add_to_list([], F, Ad, [a(F, End, [Ad|End])]). add_to_list([a(F, [Ad|End], LAd)|List], F, Ad, [a(F, End, LAd)|List]) :- !. add_to_list([X|List], F, Ad, [X|List1]) :- add_to_list(List, F, Ad, List1). terminate_list([], []). terminate_list([a(F, [], LAd)|L], [a(F, LAd)|L1]) :- terminate_list(L, L1). gen_switch([], _, fail, LNext, LNext) :- !. % if only 1 element with only 1 clause, no switch (remove if needed) gen_switch([a(_, [Ad])], _, Ad, LNext, LNext) :- !. % if only 1 element with n clauses, no switch (remove if needed) /* gen_switch([a(_, LAd)], _, Lab, LNext, WamTRT) :- !, gen_list(LAd, Lab, LNext, WamTRT). */ gen_switch(List, Ins, Lab, LNext, [label(Lab), SwtW|WamTRT]) :- create_switch_list(List, LSwt, LNext, WamTRT), SwtW =.. [Ins, LSwt]. create_switch_list([], [], LNext, LNext). create_switch_list([a(F, LAd)|List], [(F, Lab)|LSwt], LNext, WamTRT) :- gen_list(LAd, Lab, WamTRT1, WamTRT), create_switch_list(List, LSwt, LNext, WamTRT1). gen_list([], fail, LNext, LNext). gen_list([Ad], Ad, LNext, LNext) :- % only 1 Atmj, Lst or Stcj !. gen_list([Ad|LAd], Lab, LNext, WamRT1) :- % 2..n WamRT1 = [label(Lab), try(Ad)|WamRT], gen_list1(LAd, LNext, WamRT). gen_list1([Ad], LNext, [trust(Ad)|LNext]). gen_list1([Ad|LAd], LNext, WamRT1) :- WamRT1 = [retry(Ad)|WamRT], gen_list1(LAd, LNext, WamRT). gen_insts([cl(Ad, _, WamCl)], Ad, [label(Ad)|WamCl]) :- % only 1 clause !. gen_insts([cl(Ad, _, WamCl)|LCC], Lab, WamCode2) :- % 2..n gen_insts1(LCC, Lab1, WamCode), WamCode2 = [label(Lab), try_me_else(Lab1), label(Ad), WamCl|WamCode]. gen_insts1([cl(Ad, _, WamCl)], Lab, [label(Lab), trust_me_else_fail, label(Ad)|WamCl]) :- !. gen_insts1([cl(Ad, _, WamCl)|LCC], Lab, WamCode2) :- gen_insts1(LCC, Lab1, WamCode), WamCode2 = [label(Lab), retry_me_else(Lab1), label(Ad), WamCl|WamCode]. allocate_labels([], N, N) :- !. allocate_labels([WamInst1|WamInst2], N, N2) :- !, allocate_labels(WamInst1, N, N1), % for nested lists allocate_labels(WamInst2, N1, N2). allocate_labels(label(N), N, N1) :- !, N1 is N + 1 . allocate_labels(_, N, N). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/code_gen.wam���������������������������������������������������������������0000644�0001750�0001750�00000251116�13021356407�015473� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : code_gen.pl file_name('/home/diaz/GP/src/Pl2Wam/code_gen.pl'). predicate(user:code_generation/5,39,static,private,monofile,global,[ allocate(3), get_variable(y(0),1), get_variable(y(1),2), put_atom(last_pred,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_atom(treat_body,1), put_atom(f,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_value(x(3),2), put_value(y(1),1), put_variable(y(2),3), call(generate_head/5), put_atom(treat_body,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(2),2), deallocate, execute(generate_body/3)]). predicate(user:generate_head/5,49,static,private,monofile,global,[ allocate(9), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_structure(p/4,0), unify_void(2), unify_variable(x(0)), unify_variable(y(0)), get_structure((/)/2,0), unify_void(1), unify_variable(x(1)), put_integer(0,0), put_variable(y(5),2), call(gen_list_integers/3), put_value(y(0),0), put_value(y(5),1), put_variable(y(6),2), put_variable(y(7),3), call('$generate_head/5_$aux1'/4), put_value(y(6),0), put_value(y(7),1), put_value(y(3),2), put_variable(y(8),3), call(gen_unif_arg_lst/4), put_value(y(1),0), put_value(y(4),1), put_value(y(2),2), put_unsafe_value(y(8),3), deallocate, execute('$generate_head/5_$aux2'/4)]). predicate(user:'$generate_head/5_$aux2'/4,49,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), math_fast_load_value(x(0),0), put_integer(1,5), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(5)]), cut(x(4)), get_list(1), unify_variable(x(0)), unify_local_value(x(3)), get_structure(allocate/1,0), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_value(x(3),1), proceed]). predicate(user:'$generate_head/5_$aux1'/4,49,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), put_atom(reorder,5), put_atom(t,6), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(5),x(6)]), cut(x(4)), execute(reorder_head_arg_lst/4), label(1), trust_me_else_fail, get_value(x(0),2), get_value(x(1),3), proceed]). predicate(user:reorder_head_arg_lst/4,67,static,private,monofile,global,[ allocate(12), get_variable(y(0),2), get_variable(y(1),3), put_variable(y(2),2), put_variable(y(3),3), put_variable(y(4),4), put_variable(y(5),5), put_variable(y(6),6), put_variable(y(7),7), call(split_arg_lst/8), put_value(y(6),0), put_variable(y(8),1), call(reverse/2), put_value(y(7),0), put_variable(y(9),1), call(reverse/2), put_value(y(2),0), put_value(y(8),1), put_variable(y(10),2), call(append/3), put_value(y(10),0), put_value(y(4),1), put_value(y(0),2), call(append/3), put_value(y(3),0), put_value(y(9),1), put_variable(y(11),2), call(append/3), put_unsafe_value(y(11),0), put_unsafe_value(y(5),1), put_value(y(1),2), deallocate, execute(append/3)]). predicate(user:generate_body/3,79,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_list(2), unify_atom(proceed), unify_nil, proceed, label(3), trust_me_else_fail, label(4), allocate(8), get_list(0), unify_variable(x(0)), unify_variable(y(5)), get_structure(p/4,0), unify_variable(y(0)), unify_variable(y(1)), unify_variable(x(0)), unify_variable(y(4)), get_structure((/)/2,0), unify_variable(y(2)), unify_variable(y(3)), get_variable(y(6),1), get_variable(y(7),2), put_value(y(0),0), put_value(y(6),1), call('$generate_body/3_$aux1'/2), put_value(y(2),0), put_value(y(3),1), put_value(y(1),2), put_value(y(4),3), put_value(y(0),4), put_value(y(5),5), put_value(y(6),6), put_value(y(7),7), deallocate, execute(generate_body1/8)]). predicate(user:'$generate_body/3_$aux1'/2,81,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_value(x(1),0), cut(x(2)), put_atom(last_pred,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, proceed]). predicate(user:generate_body1/8,90,static,private,monofile,global,[ pragma_arity(9), get_current_choice(x(8)), try_me_else(6), switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(fail,3),('$call_c',5)]), label(2), try_me_else(4), label(3), get_atom(fail,0), get_integer(0,1), get_list(7), unify_atom(fail), unify_nil, cut(x(8)), proceed, label(4), trust_me_else_fail, label(5), allocate(10), get_atom('$call_c',0), get_integer(2,1), get_variable(y(1),4), get_variable(y(2),5), get_variable(y(3),6), get_variable(y(4),7), get_list(3), unify_variable(x(0)), unify_list, unify_variable(y(0)), unify_nil, cut(x(8)), put_variable(y(5),1), put_variable(y(6),2), call('$generate_body1/8_$aux1'/3), put_value(y(2),0), put_value(y(0),1), put_variable(y(7),2), call('$generate_body1/8_$aux2'/3), put_value(y(0),0), put_value(y(6),1), put_variable(y(8),2), put_variable(y(9),3), put_value(y(4),4), call(load_c_call_args/5), put_structure(call_c/3,3), unify_local_value(y(5)), unify_local_value(y(7)), unify_local_value(y(8)), put_value(y(2),0), put_value(y(1),1), put_unsafe_value(y(9),2), put_value(y(3),4), deallocate, execute('$generate_body1/8_$aux3'/5), label(6), retry_me_else(7), allocate(9), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_variable(y(5),6), get_variable(y(6),7), get_variable(y(7),8), put_value(y(0),0), put_value(y(1),1), call(inline_predicate/2), cut(y(7)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_variable(y(8),3), put_value(y(6),4), call(gen_inline_pred/5), cut(y(7)), put_value(y(4),0), put_value(y(3),1), put_unsafe_value(y(8),2), put_value(y(5),3), deallocate, execute('$generate_body1/8_$aux4'/4), label(7), trust_me_else_fail, allocate(13), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), get_variable(y(7),7), put_integer(0,0), put_value(y(1),1), put_variable(y(8),2), call(gen_list_integers/3), put_value(y(3),0), put_value(y(8),1), put_variable(y(9),2), put_variable(y(10),3), call('$generate_body1/8_$aux5'/4), put_value(y(9),0), put_value(y(10),1), put_variable(y(11),2), put_value(y(7),3), call(gen_load_arg_lst/4), put_value(y(2),0), put_value(y(0),1), put_value(y(1),2), put_variable(y(12),3), call(qualif_with_module/4), put_value(y(5),0), put_value(y(4),1), put_unsafe_value(y(11),2), put_unsafe_value(y(12),3), put_value(y(6),4), deallocate, execute('$generate_body1/8_$aux6'/5)]). predicate(user:'$generate_body1/8_$aux6'/5,132,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_nil(0), cut(x(5)), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), execute('$generate_body1/8_$aux7'/3), label(1), trust_me_else_fail, get_list(2), unify_variable(x(1)), unify_variable(x(2)), get_structure(call/1,1), unify_local_value(x(3)), put_value(x(4),1), execute(generate_body/3)]). predicate(user:'$generate_body1/8_$aux7'/3,132,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), math_fast_load_value(x(0),0), put_integer(1,4), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(4)]), cut(x(3)), get_list(1), unify_atom(deallocate), unify_list, unify_variable(x(0)), unify_nil, get_structure(execute/1,0), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_list(1), unify_variable(x(0)), unify_nil, get_structure(execute/1,0), unify_local_value(x(2)), proceed]). predicate(user:'$generate_body1/8_$aux5'/4,132,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), put_atom(reorder,5), put_atom(t,6), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(5),x(6)]), cut(x(4)), execute(reorder_body_arg_lst/4), label(1), trust_me_else_fail, get_value(x(0),2), get_value(x(1),3), proceed]). predicate(user:'$generate_body1/8_$aux4'/4,118,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_nil(0), cut(x(4)), put_value(x(1),0), put_value(x(2),1), execute('$generate_body1/8_$aux8'/2), label(1), trust_me_else_fail, put_value(x(3),1), execute(generate_body/3)]). predicate(user:'$generate_body1/8_$aux8'/2,118,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), math_fast_load_value(x(0),0), put_integer(1,3), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), get_list(1), unify_atom(deallocate), unify_list, unify_atom(proceed), unify_nil, proceed, label(1), trust_me_else_fail, get_list(1), unify_atom(proceed), unify_nil, proceed]). predicate(user:'$generate_body1/8_$aux3'/5,93,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_nil(0), cut(x(5)), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), execute('$generate_body1/8_$aux9'/3), label(1), trust_me_else_fail, get_list(2), unify_local_value(x(3)), unify_variable(x(2)), put_value(x(4),1), execute(generate_body/3)]). predicate(user:'$generate_body1/8_$aux9'/3,93,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), math_fast_load_value(x(0),0), put_integer(1,4), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(4)]), cut(x(3)), get_list(1), unify_atom(deallocate), unify_list, unify_local_value(x(2)), unify_list, unify_atom(proceed), unify_nil, proceed, label(1), trust_me_else_fail, get_list(1), unify_local_value(x(2)), unify_list, unify_atom(proceed), unify_nil, proceed]). predicate(user:'$generate_body1/8_$aux2'/3,93,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(3), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom(jump,0), put_value(y(0),1), call(memberchk/2), cut(y(2)), put_value(y(1),0), get_list(0), unify_atom(set_cp), unify_local_value(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(1),2), proceed]). predicate(user:'$generate_body1/8_$aux1'/3,93,static,private,monofile,local,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(atm/1,3),(stc/3,5)]), label(2), try_me_else(4), label(3), get_structure(atm/1,0), unify_local_value(x(1)), get_nil(2), proceed, label(4), trust_me_else_fail, label(5), get_structure(stc/3,0), unify_local_value(x(1)), unify_void(1), unify_local_value(x(2)), proceed]). predicate(user:qualif_with_module/4,155,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_structure((:)/2,3), unify_local_value(x(0)), unify_structure((/)/2), unify_local_value(x(1)), unify_local_value(x(2)), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_atom(system,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom(user,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(x(4)), proceed, label(1), trust_me_else_fail, get_structure((/)/2,3), unify_local_value(x(1)), unify_local_value(x(2)), proceed]). predicate(user:reorder_body_arg_lst/4,166,static,private,monofile,global,[ allocate(10), get_variable(y(0),2), get_variable(y(1),3), put_variable(y(2),2), put_variable(y(3),3), put_variable(y(4),4), put_variable(y(5),5), put_variable(y(6),6), put_variable(y(7),7), call(split_arg_lst/8), put_value(y(4),0), put_value(y(6),1), put_variable(y(8),2), call(append/3), put_value(y(8),0), put_value(y(2),1), put_value(y(0),2), call(append/3), put_value(y(5),0), put_value(y(7),1), put_variable(y(9),2), call(append/3), put_unsafe_value(y(9),0), put_unsafe_value(y(3),1), put_value(y(1),2), deallocate, execute(append/3)]). predicate(user:split_arg_lst/8,181,static,private,monofile,global,[ pragma_arity(9), get_current_choice(x(8)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), get_nil(4), get_nil(5), get_nil(6), get_nil(7), proceed, label(3), trust_me_else_fail, label(4), allocate(9), get_variable(x(11),7), get_variable(x(7),5), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(12)), unify_variable(y(1)), get_variable(y(2),8), put_value(x(2),1), put_value(x(4),5), put_value(x(6),9), put_variable(y(3),2), put_variable(y(4),4), put_variable(y(5),6), put_variable(y(6),8), put_variable(y(7),10), put_variable(y(8),13), call('$split_arg_lst/8_$aux1'/14), cut(y(2)), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), put_unsafe_value(y(5),4), put_unsafe_value(y(6),5), put_unsafe_value(y(7),6), put_unsafe_value(y(8),7), deallocate, execute(split_arg_lst/8)]). predicate(user:'$split_arg_lst/8_$aux1'/14,183,static,private,monofile,local,[ try_me_else(1), get_structure(var/2,0), unify_variable(x(14)), unify_void(1), get_structure(x/1,14), unify_variable(x(14)), put_atom(void,15), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(14),x(15)]), get_value(x(2),1), get_value(x(4),3), get_value(x(6),5), get_value(x(8),7), get_list(9), unify_local_value(x(0)), unify_local_value(x(10)), get_list(11), unify_local_value(x(12)), unify_local_value(x(13)), proceed, label(1), retry_me_else(2), allocate(14), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), get_variable(y(7),7), get_variable(y(8),8), get_variable(y(9),9), get_variable(y(10),10), get_variable(y(11),11), get_variable(y(12),12), get_variable(y(13),13), put_value(y(0),0), get_structure(stc/3,0), unify_void(2), unify_variable(x(0)), call(has_temporaries/1), put_value(y(1),0), get_value(y(2),0), put_value(y(3),0), get_value(y(4),0), put_value(y(5),0), get_list(0), unify_local_value(y(0)), unify_local_value(y(6)), put_value(y(7),0), get_list(0), unify_local_value(y(12)), unify_local_value(y(8)), put_value(y(9),0), get_value(y(10),0), put_value(y(11),0), get_value(y(13),0), deallocate, proceed, label(2), trust_me_else_fail, get_list(1), unify_local_value(x(0)), unify_local_value(x(2)), get_list(3), unify_local_value(x(12)), unify_local_value(x(4)), get_value(x(6),5), get_value(x(8),7), get_value(x(10),9), get_value(x(13),11), proceed]). predicate(user:has_temporaries/1,214,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(x(2)), get_variable(y(0),1), put_value(x(2),1), call('$has_temporaries/1_$aux1'/2), cut(y(0)), deallocate, proceed]). predicate(user:'$has_temporaries/1_$aux1'/2,214,static,private,monofile,local,[ try_me_else(6), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(var/2,3),(stc/3,5)]), label(2), try_me_else(4), label(3), get_structure(var/2,0), unify_variable(x(0)), unify_void(1), get_structure(x/1,0), unify_variable(x(0)), put_atom(void,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), proceed, label(4), trust_me_else_fail, label(5), get_structure(stc/3,0), unify_void(2), unify_variable(x(0)), execute(has_temporaries/1), label(6), trust_me_else_fail, put_value(x(1),0), execute(has_temporaries/1)]). predicate(user:gen_unif_arg_lst/4,229,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), put_variable(y(3),2), call(gen_unif_arg/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(gen_unif_arg_lst/4)]). predicate(user:gen_unif_arg/4,240,static,private,monofile,global,[ switch_on_term(2,11,fail,fail,1), label(1), switch_on_structure([(var/2,3),(atm/1,5),(int/1,7),(flt/1,9),(stc/3,13)]), label(2), try_me_else(4), label(3), get_variable(x(5),3), get_variable(x(3),2), get_variable(x(4),1), get_structure(var/2,0), unify_variable(x(1)), unify_variable(x(0)), put_value(x(5),2), execute('$gen_unif_arg/4_$aux1'/5), label(4), retry_me_else(6), label(5), get_structure(atm/1,0), unify_variable(x(0)), get_list(3), unify_variable(x(3)), unify_local_value(x(2)), get_structure(get_atom/2,3), unify_value(x(0)), unify_local_value(x(1)), proceed, label(6), retry_me_else(8), label(7), get_structure(int/1,0), unify_variable(x(0)), get_list(3), unify_variable(x(3)), unify_local_value(x(2)), get_structure(get_integer/2,3), unify_value(x(0)), unify_local_value(x(1)), proceed, label(8), retry_me_else(10), label(9), get_structure(flt/1,0), unify_variable(x(0)), get_list(3), unify_variable(x(3)), unify_local_value(x(2)), get_structure(get_float/2,3), unify_value(x(0)), unify_local_value(x(1)), proceed, label(10), retry_me_else(12), label(11), get_atom(nil,0), get_list(3), unify_variable(x(0)), unify_local_value(x(2)), get_structure(get_nil/1,0), unify_local_value(x(1)), proceed, label(12), trust_me_else_fail, label(13), allocate(7), get_variable(y(1),2), get_variable(x(4),1), get_structure(stc/3,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(y(0)), get_list(3), unify_variable(x(2)), unify_variable(y(2)), put_value(x(4),3), call('$gen_unif_arg/4_$aux2'/4), put_value(y(0),0), put_atom(head,1), put_variable(y(3),2), put_variable(y(4),3), put_variable(y(5),4), call(flat_stc_arg_lst/5), put_value(y(3),0), put_variable(y(6),1), put_value(y(2),2), call(gen_subterm_arg_lst/3), put_unsafe_value(y(4),0), put_unsafe_value(y(5),1), put_value(y(1),2), put_unsafe_value(y(6),3), deallocate, execute(gen_unif_arg_lst/4)]). predicate(user:'$gen_unif_arg/4_$aux2'/4,264,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_atom('.',0), get_integer(2,1), cut(x(4)), get_structure(get_list/1,2), unify_local_value(x(3)), proceed, label(1), trust_me_else_fail, get_structure(get_structure/2,2), unify_variable(x(2)), unify_local_value(x(3)), get_structure((/)/2,2), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(user:'$gen_unif_arg/4_$aux1'/5,240,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_variable(x(6),3), get_variable(x(3),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(3)]), cut(x(5)), put_value(x(1),0), put_value(x(2),1), put_value(x(6),2), execute('$gen_unif_arg/4_$aux3'/5), label(1), trust_me_else_fail, get_list(2), unify_variable(x(0)), unify_local_value(x(3)), get_structure(get_value/2,0), unify_local_value(x(1)), unify_local_value(x(4)), proceed]). predicate(user:'$gen_unif_arg/4_$aux3'/5,240,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), put_structure(x/1,3), unify_atom(void), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(3)]), cut(x(5)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),4), put_value(x(3),1), put_value(y(0),0), call('$gen_unif_arg/4_$aux4'/2), put_value(y(1),0), get_list(0), unify_variable(x(0)), unify_local_value(y(2)), get_structure(get_variable/2,0), unify_local_value(y(0)), unify_local_value(y(3)), deallocate, proceed]). predicate(user:'$gen_unif_arg/4_$aux4'/2,240,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(treat_body,3), put_atom(t,4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(3),x(4)]), get_structure(y/1,0), unify_void(1), cut(x(2)), get_atom(unsafe,1), proceed, label(1), trust_me_else_fail, get_atom(not_in_cur_env,1), proceed]). predicate(user:gen_load_arg_lst/4,279,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), put_variable(y(3),2), call(gen_load_arg/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(gen_load_arg_lst/4)]). predicate(user:gen_load_arg/4,290,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), switch_on_term(3,12,fail,fail,1), label(1), switch_on_structure([(var/2,4),(atm/1,6),(int/1,8),(flt/1,10),(stc/3,2)]), label(2), try(14), trust(16), label(3), try_me_else(5), label(4), allocate(4), get_variable(y(0),2), get_variable(y(1),3), get_variable(x(3),1), get_structure(var/2,0), unify_variable(x(1)), unify_variable(x(0)), put_variable(y(2),2), put_variable(y(3),4), call('$gen_load_arg/4_$aux1'/5), put_unsafe_value(y(3),0), put_value(y(1),1), put_unsafe_value(y(2),2), put_value(y(0),3), deallocate, execute('$gen_load_arg/4_$aux2'/4), label(5), retry_me_else(7), label(6), get_structure(atm/1,0), unify_variable(x(0)), get_list(3), unify_variable(x(3)), unify_local_value(x(2)), get_structure(put_atom/2,3), unify_value(x(0)), unify_local_value(x(1)), proceed, label(7), retry_me_else(9), label(8), get_structure(int/1,0), unify_variable(x(0)), get_list(3), unify_variable(x(3)), unify_local_value(x(2)), get_structure(put_integer/2,3), unify_value(x(0)), unify_local_value(x(1)), proceed, label(9), retry_me_else(11), label(10), get_structure(flt/1,0), unify_variable(x(0)), get_list(3), unify_variable(x(3)), unify_local_value(x(2)), get_structure(put_float/2,3), unify_value(x(0)), unify_local_value(x(1)), proceed, label(11), retry_me_else(13), label(12), get_atom(nil,0), get_list(3), unify_variable(x(0)), unify_local_value(x(2)), get_structure(put_nil/1,0), unify_local_value(x(1)), proceed, label(13), retry_me_else(15), label(14), allocate(5), get_variable(y(1),1), get_variable(y(2),2), get_structure(stc/3,0), unify_atom('$mt'), unify_integer(2), unify_list, unify_variable(x(1)), unify_list, unify_variable(x(0)), unify_nil, get_structure(atm/1,1), unify_variable(y(0)), cut(x(4)), put_variable(y(3),1), put_variable(y(4),2), call(gen_load_arg/4), put_unsafe_value(y(4),0), get_list(0), unify_variable(x(0)), unify_local_value(y(2)), get_structure(put_meta_term/3,0), unify_value(y(0)), unify_local_value(y(3)), unify_local_value(y(1)), deallocate, proceed, label(15), trust_me_else_fail, label(16), allocate(8), get_variable(y(1),2), get_variable(y(2),3), get_variable(x(3),1), get_structure(stc/3,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(y(0)), put_variable(y(3),2), call('$gen_load_arg/4_$aux3'/4), put_value(y(0),0), put_atom(body,1), put_variable(y(4),2), put_variable(y(5),3), put_variable(y(6),4), call(flat_stc_arg_lst/5), put_value(y(5),0), put_value(y(6),1), put_list(2), unify_local_value(y(3)), unify_variable(y(7)), put_value(y(2),3), call(gen_load_arg_lst/4), put_unsafe_value(y(4),0), put_value(y(1),1), put_value(y(7),2), deallocate, execute(gen_subterm_arg_lst/3)]). predicate(user:'$gen_load_arg/4_$aux3'/4,335,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_atom('.',0), get_integer(2,1), cut(x(4)), get_structure(put_list/1,2), unify_local_value(x(3)), proceed, label(1), trust_me_else_fail, get_structure(put_structure/2,2), unify_variable(x(2)), unify_local_value(x(3)), get_structure((/)/2,2), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(user:'$gen_load_arg/4_$aux2'/4,290,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(4)), get_list(1), unify_local_value(x(2)), unify_local_value(x(3)), proceed, label(1), trust_me_else_fail, get_list(1), unify_local_value(x(2)), unify_list, unify_local_value(x(0)), unify_local_value(x(3)), proceed]). predicate(user:'$gen_load_arg/4_$aux1'/5,290,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_variable(x(6),3), get_variable(x(3),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(3)]), cut(x(5)), put_value(x(1),0), put_value(x(2),1), put_value(x(6),2), execute('$gen_load_arg/4_$aux4'/5), label(1), retry_me_else(2), get_atom(unsafe,0), put_atom(last_pred,0), put_atom(t,4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(4)]), cut(x(5)), get_structure(put_unsafe_value/2,2), unify_local_value(x(1)), unify_local_value(x(3)), proceed, label(2), trust_me_else_fail, get_structure(put_value/2,2), unify_local_value(x(1)), unify_local_value(x(3)), proceed]). predicate(user:'$gen_load_arg/4_$aux4'/5,290,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), put_structure(x/1,3), unify_atom(void), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(3)]), cut(x(5)), get_structure(put_void/1,1), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(x(3),1), put_value(x(4),2), put_value(y(0),0), put_value(y(2),3), call('$gen_load_arg/4_$aux5'/4), put_value(y(1),0), get_structure(put_variable/2,0), unify_local_value(y(0)), unify_local_value(y(2)), deallocate, proceed]). predicate(user:'$gen_load_arg/4_$aux5'/4,290,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_structure(x/1,0), unify_void(1), cut(x(4)), get_atom(in_heap,1), proceed, label(1), trust_me_else_fail, get_variable(x(4),1), get_variable(x(1),0), get_atom(unsafe,4), put_value(x(2),0), put_value(x(3),2), execute('$gen_load_arg/4_$aux6'/3)]). predicate(user:'$gen_load_arg/4_$aux6'/3,290,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), put_atom(last_pred,4), put_atom(t,5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), get_structure(put_unsafe_value/2,0), unify_local_value(x(1)), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, proceed]). predicate(user:flat_stc_arg_lst/5,351,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), switch_on_term(2,3,fail,1,fail), label(1), try(5), retry(7), trust(9), label(2), try_me_else(4), label(3), get_nil(0), get_nil(2), get_nil(3), get_nil(4), proceed, label(4), retry_me_else(6), label(5), allocate(6), get_variable(y(1),1), get_variable(y(3),3), get_variable(y(4),4), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(2), unify_value(x(0)), unify_variable(y(2)), get_variable(y(5),5), call(simple_stc_arg/1), cut(y(5)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute(flat_stc_arg_lst/5), label(6), retry_me_else(8), label(7), allocate(6), get_variable(y(0),1), get_variable(y(2),3), get_variable(y(3),4), get_list(0), unify_variable(x(3)), unify_nil, get_list(2), unify_variable(x(0)), unify_nil, get_structure(stc/3,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(y(1)), get_variable(y(4),5), put_atom(opt_last_subterm,2), put_atom(t,4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(4)]), get_structure(stc/3,3), unify_value(x(0)), unify_value(x(1)), unify_variable(y(5)), call('$flat_stc_arg_lst/5_$aux1'/2), cut(y(4)), put_value(y(5),0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), put_value(y(3),4), deallocate, execute(flat_stc_arg_lst/5), label(8), trust_me_else_fail, label(9), allocate(5), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(2), unify_variable(x(1)), unify_variable(y(2)), get_list(3), unify_value(x(0)), unify_variable(y(3)), get_list(4), unify_variable(x(2)), unify_variable(y(4)), put_value(y(1),0), call('$flat_stc_arg_lst/5_$aux2'/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute(flat_stc_arg_lst/5)]). predicate(user:'$flat_stc_arg_lst/5_$aux2'/3,363,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(head,0), cut(x(3)), get_structure(var/2,1), unify_variable(x(0)), unify_void(1), get_structure(x/1,0), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_structure(var/2,1), unify_variable(x(0)), unify_atom(in_heap), get_structure(x/1,0), unify_local_value(x(2)), proceed]). predicate(user:'$flat_stc_arg_lst/5_$aux1'/2,357,static,private,monofile,local,[ try_me_else(1), put_atom('$mt',1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_integer(2,0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), proceed]). predicate(user:simple_stc_arg/1,373,static,private,monofile,global,[ switch_on_term(2,9,fail,fail,1), label(1), switch_on_structure([(var/2,3),(atm/1,5),(int/1,7)]), label(2), try_me_else(4), label(3), get_structure(var/2,0), unify_void(2), proceed, label(4), retry_me_else(6), label(5), get_structure(atm/1,0), unify_void(1), proceed, label(6), retry_me_else(8), label(7), get_structure(int/1,0), unify_void(1), proceed, label(8), trust_me_else_fail, label(9), get_atom(nil,0), proceed]). predicate(user:gen_subterm_arg_lst/3,386,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), proceed, label(3), trust_me_else_fail, label(4), allocate(6), get_list(0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),1), get_variable(y(3),2), put_list(0), unify_value(y(0)), unify_value(y(1)), put_integer(0,1), put_variable(y(4),2), put_variable(y(5),3), call(gen_compte_void/4), put_unsafe_value(y(4),0), put_value(y(0),1), put_value(y(3),2), put_value(y(1),3), put_value(y(2),4), put_unsafe_value(y(5),5), deallocate, execute('$gen_subterm_arg_lst/3_$aux1'/6)]). predicate(user:'$gen_subterm_arg_lst/3_$aux1'/6,388,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(3), get_variable(y(0),3), get_variable(y(1),4), get_integer(0,0), cut(x(6)), put_value(x(1),0), put_variable(y(2),1), call(gen_subterm_arg/3), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(2),2), deallocate, execute(gen_subterm_arg_lst/3), label(1), trust_me_else_fail, get_list(2), unify_variable(x(1)), unify_variable(x(2)), get_structure(unify_void/1,1), unify_local_value(x(0)), put_value(x(5),0), put_value(x(4),1), execute(gen_subterm_arg_lst/3)]). predicate(user:gen_compte_void/4,401,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_list(0), unify_variable(x(5)), unify_variable(x(0)), get_structure(var/2,5), unify_variable(x(5)), unify_void(1), get_structure(x/1,5), unify_variable(x(5)), put_atom(void,6), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(5),x(6)]), cut(x(4)), math_fast_load_value(x(1),1), call_c('Pl_Fct_Fast_Inc',[fast_call,x(1)],[x(1)]), execute(gen_compte_void/4), label(1), trust_me_else_fail, get_value(x(2),1), get_value(x(3),0), proceed]). predicate(user:gen_subterm_arg/3,411,static,private,monofile,global,[ switch_on_term(2,9,fail,fail,1), label(1), switch_on_structure([(var/2,3),(atm/1,5),(int/1,7),(stc/3,11)]), label(2), try_me_else(4), label(3), get_variable(x(4),1), get_structure(var/2,0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_variable(x(1)), unify_local_value(x(4)), put_value(x(3),2), execute('$gen_subterm_arg/3_$aux1'/3), label(4), retry_me_else(6), label(5), get_structure(atm/1,0), unify_variable(x(0)), get_list(2), unify_variable(x(2)), unify_local_value(x(1)), get_structure(unify_atom/1,2), unify_value(x(0)), proceed, label(6), retry_me_else(8), label(7), get_structure(int/1,0), unify_variable(x(0)), get_list(2), unify_variable(x(2)), unify_local_value(x(1)), get_structure(unify_integer/1,2), unify_value(x(0)), proceed, label(8), retry_me_else(10), label(9), get_atom(nil,0), get_list(2), unify_atom(unify_nil), unify_local_value(x(1)), proceed, label(10), trust_me_else_fail, label(11), allocate(3), get_variable(y(1),1), get_structure(stc/3,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(y(0)), get_list(2), unify_variable(x(2)), unify_variable(y(2)), call('$gen_subterm_arg/3_$aux2'/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(gen_subterm_arg_lst/3)]). predicate(user:'$gen_subterm_arg/3_$aux2'/3,428,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom('.',0), get_integer(2,1), cut(x(3)), get_atom(unify_list,2), proceed, label(1), trust_me_else_fail, get_structure(unify_structure/1,2), unify_structure((/)/2), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(user:'$gen_subterm_arg/3_$aux1'/3,411,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), get_atom(in_heap,0), get_structure(unify_variable/1,1), unify_local_value(x(2)), proceed, label(1), retry_me_else(2), get_atom(in_heap,0), cut(x(3)), get_structure(unify_value/1,1), unify_local_value(x(2)), proceed, label(2), trust_me_else_fail, get_structure(unify_local_value/1,1), unify_local_value(x(2)), proceed]). predicate(user:gen_list_integers/3,440,static,private,monofile,global,[ execute('$gen_list_integers/3_$aux1'/3)]). predicate(user:'$gen_list_integers/3_$aux1'/3,440,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), math_fast_load_value(x(0),4), math_fast_load_value(x(1),5), call_c('Pl_Blt_Fast_Lt',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), get_list(2), unify_local_value(x(0)), unify_variable(x(2)), math_fast_load_value(x(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), execute(gen_list_integers/3), label(1), trust_me_else_fail, get_nil(2), proceed]). predicate(user:special_form/2,454,static,private,monofile,global,[ get_structure(put_variable/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(x/1,2), unify_value(x(0)), get_structure(put_void/1,1), unify_value(x(0)), proceed]). predicate(user:dummy_instruction/2,459,static,private,monofile,global,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(get_variable/2,3),(put_value/2,5)]), label(2), try_me_else(4), label(3), get_atom(f,1), get_structure(get_variable/2,0), unify_variable(x(1)), unify_variable(x(0)), get_structure(x/1,1), unify_value(x(0)), proceed, label(4), trust_me_else_fail, label(5), get_atom(f,1), get_structure(put_value/2,0), unify_variable(x(1)), unify_variable(x(0)), get_structure(x/1,1), unify_value(x(0)), proceed]). predicate(user:equal/4,501,static,private,monofile,global,[ try_me_else(1), get_value(x(3),2), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), proceed, label(1), retry_me_else(2), get_value(x(3),2), get_structure(var/2,0), unify_variable(x(0)), unify_variable(x(1)), get_structure(x/1,0), unify_variable(x(0)), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), put_atom(void,1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), proceed, label(2), retry_me_else(3), get_value(x(3),2), get_structure(var/2,1), unify_variable(x(0)), unify_variable(x(1)), get_structure(x/1,0), unify_variable(x(0)), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), put_atom(void,1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), proceed, label(3), retry_me_else(4), get_value(x(3),2), get_structure(var/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(var/2,1), unify_value(x(2)), unify_value(x(0)), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(4), retry_me_else(5), get_variable(x(6),3), get_variable(x(4),1), get_variable(x(5),0), get_structure(var/2,5), unify_variable(x(0)), unify_variable(x(3)), put_value(x(2),1), put_value(x(6),2), execute('$equal/4_$aux1'/6), label(5), retry_me_else(6), get_variable(x(6),3), get_variable(x(5),1), get_variable(x(4),0), get_structure(var/2,5), unify_variable(x(0)), unify_variable(x(3)), put_value(x(2),1), put_value(x(6),2), execute('$equal/4_$aux2'/6), label(6), retry_me_else(7), get_variable(x(4),3), get_variable(x(3),2), get_variable(x(2),0), get_structure(var/2,1), unify_variable(x(1)), unify_variable(x(0)), get_structure(x/1,1), unify_variable(x(1)), execute(inline_unif_reg_term/5), label(7), retry_me_else(8), get_structure(stc/3,0), unify_variable(x(5)), unify_variable(x(4)), unify_variable(x(0)), get_structure(stc/3,1), unify_value(x(5)), unify_value(x(4)), unify_variable(x(1)), execute(equal_lst/4), label(8), trust_me_else_fail, get_list(3), unify_atom(fail), unify_local_value(x(2)), put_atom('explicit unification will fail',0), put_nil(1), execute(warn/2)]). predicate(user:'$equal/4_$aux2'/6,528,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), get_structure(x/1,0), unify_variable(x(0)), cut(x(6)), execute('$equal/4_$aux3'/5), label(1), trust_me_else_fail, allocate(4), get_variable(y(0),1), get_variable(y(1),4), put_value(x(5),0), put_value(x(2),3), put_variable(y(2),1), put_variable(y(3),2), call(gen_load_arg/4), put_value(y(1),0), put_unsafe_value(y(2),1), put_value(y(0),2), put_unsafe_value(y(3),3), deallocate, execute(gen_unif_arg/4)]). predicate(user:'$equal/4_$aux3'/5,528,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), put_atom(void,3), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(3)]), cut(x(5)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_variable(x(5),4), get_variable(x(6),3), get_variable(x(4),2), get_variable(x(3),1), get_variable(x(1),0), put_value(x(6),0), put_value(x(5),2), execute(inline_unif_reg_term/5)]). predicate(user:'$equal/4_$aux1'/6,515,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), get_structure(x/1,0), unify_variable(x(0)), cut(x(6)), execute('$equal/4_$aux4'/5), label(1), trust_me_else_fail, allocate(4), get_variable(y(0),1), get_variable(y(1),4), put_value(x(5),0), put_value(x(2),3), put_variable(y(2),1), put_variable(y(3),2), call(gen_load_arg/4), put_value(y(1),0), put_unsafe_value(y(2),1), put_value(y(0),2), put_unsafe_value(y(3),3), deallocate, execute(gen_unif_arg/4)]). predicate(user:'$equal/4_$aux4'/5,515,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), put_atom(void,3), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(3)]), cut(x(5)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_variable(x(5),4), get_variable(x(6),3), get_variable(x(4),2), get_variable(x(3),1), get_variable(x(1),0), put_value(x(6),0), put_value(x(5),2), execute(inline_unif_reg_term/5)]). predicate(user:equal_lst/4,553,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), put_variable(y(3),2), call(equal/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(equal_lst/4)]). predicate(user:inline_unif_reg_term/5,562,static,private,monofile,global,[ get_variable(x(5),2), get_variable(x(2),1), put_value(x(5),1), execute('$inline_unif_reg_term/5_$aux1'/5)]). predicate(user:'$inline_unif_reg_term/5_$aux1'/5,562,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),3), get_variable(y(2),4), put_value(y(0),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(5)), put_value(x(1),0), put_value(x(2),1), put_value(y(1),2), put_variable(y(3),3), call(gen_load_arg/4), put_value(y(0),0), put_value(y(2),1), put_unsafe_value(y(3),2), put_value(y(1),3), deallocate, execute('$inline_unif_reg_term/5_$aux2'/4), label(1), trust_me_else_fail, put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), execute(gen_unif_arg/4)]). predicate(user:'$inline_unif_reg_term/5_$aux2'/4,562,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(4)), get_atom(in_heap,0), get_value(x(2),1), proceed, label(1), trust_me_else_fail, allocate(2), get_variable(y(0),1), get_variable(y(1),3), put_atom('explicit unification will fail due to cyclic term (occurs check)',0), put_nil(1), call(warn/2), put_value(y(0),0), get_list(0), unify_atom(fail), unify_local_value(y(1)), deallocate, proceed]). predicate(user:load_math_expr/4,597,static,private,monofile,global,[ try_me_else(12), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(var/2,3),(int/1,5),(flt/1,7),(stc/3,9),(atm/1,11)]), label(2), try_me_else(4), label(3), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_structure(var/2,0), unify_variable(y(0)), unify_variable(x(0)), call('$load_math_expr/4_$aux1'/1), put_value(y(3),0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), deallocate, execute('$load_math_expr/4_$aux2'/4), label(4), retry_me_else(6), label(5), get_structure(int/1,0), unify_variable(x(4)), put_structure(int/1,0), unify_value(x(4)), execute(gen_load_arg/4), label(6), retry_me_else(8), label(7), get_structure(flt/1,0), unify_variable(x(4)), put_structure(flt/1,0), unify_value(x(4)), execute(gen_load_arg/4), label(8), retry_me_else(10), label(9), get_variable(x(5),3), get_variable(x(4),2), get_variable(x(3),1), get_structure(stc/3,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(x(2)), execute(load_math_expr1/6), label(10), trust_me_else_fail, label(11), get_variable(x(5),3), get_structure(atm/1,0), unify_variable(x(0)), put_value(x(1),3), put_value(x(2),4), put_integer(0,1), put_nil(2), execute(load_math_expr1/6), label(12), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('unknown expression in arithmetic expression (~q)',0), execute(error/2)]). predicate(user:'$load_math_expr/4_$aux2'/4,597,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), put_atom(fast_math,5), put_atom(t,6), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(5),x(6)]), cut(x(4)), get_list(0), unify_variable(x(0)), unify_local_value(x(3)), get_structure(math_fast_load_value/2,0), unify_local_value(x(1)), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_list(0), unify_variable(x(0)), unify_local_value(x(3)), get_structure(math_load_value/2,0), unify_local_value(x(1)), unify_local_value(x(2)), proceed]). predicate(user:'$load_math_expr/4_$aux1'/1,597,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), put_atom('unbound variable in arithmetic expression',0), put_nil(1), execute(error/2), label(1), trust_me_else_fail, proceed]). predicate(user:load_math_expr1/6,624,static,private,monofile,global,[ try_me_else(11), switch_on_term(3,1,fail,fail,fail), label(1), switch_on_atom([('.',4),((+),2),((-),10)]), label(2), try(6), trust(8), label(3), try_me_else(5), label(4), get_atom('.',0), get_integer(2,1), get_list(2), unify_variable(x(0)), unify_list, unify_atom(nil), unify_nil, put_value(x(3),1), put_value(x(4),2), put_value(x(5),3), execute(load_math_expr/4), label(5), retry_me_else(7), label(6), get_atom(+,0), get_integer(1,1), get_list(2), unify_variable(x(0)), unify_nil, put_value(x(3),1), put_value(x(4),2), put_value(x(5),3), execute(load_math_expr/4), label(7), retry_me_else(9), label(8), get_atom(+,0), get_integer(2,1), get_list(2), unify_variable(x(0)), unify_list, unify_variable(x(1)), unify_nil, get_structure(int/1,1), unify_integer(1), put_list(2), unify_value(x(0)), unify_nil, put_atom(inc,0), put_integer(1,1), execute(load_math_expr1/6), label(9), trust_me_else_fail, label(10), get_atom(-,0), get_integer(2,1), get_list(2), unify_variable(x(0)), unify_list, unify_variable(x(1)), unify_nil, get_structure(int/1,1), unify_integer(1), put_list(2), unify_value(x(0)), unify_nil, put_atom(dec,0), put_integer(1,1), execute(load_math_expr1/6), label(11), retry_me_else(12), allocate(7), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), put_variable(y(4),2), call('$load_math_expr1/6_$aux1'/3), put_value(y(0),0), put_variable(y(5),1), put_variable(y(6),2), put_value(y(3),3), call(load_math_arg_lst/4), put_unsafe_value(y(6),0), get_list(0), unify_variable(x(0)), unify_local_value(y(2)), get_structure(call_c/3,0), unify_local_value(y(4)), unify_variable(x(0)), unify_local_value(y(5)), get_list(0), unify_atom(fast_call), unify_list, unify_variable(x(0)), unify_nil, get_structure(x/1,0), unify_local_value(y(1)), deallocate, proceed, label(12), retry_me_else(13), allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), put_value(y(1),1), put_void(2), call(math_exp_functor_name/3), put_atom('arithmetic operation not allowed in fast math (~q)',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(error/2), label(13), trust_me_else_fail, put_structure((/)/2,2), unify_local_value(x(0)), unify_local_value(x(1)), put_list(1), unify_value(x(2)), unify_nil, put_atom('unknown operation in arithmetic expression (~q)',0), execute(error/2)]). predicate(user:'$load_math_expr1/6_$aux1'/3,636,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), put_atom(fast_math,4), put_atom(t,5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), execute(fast_exp_functor_name/3), label(1), trust_me_else_fail, execute(math_exp_functor_name/3)]). predicate(user:load_math_arg_lst/4,655,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), get_structure(x/1,1), unify_variable(x(1)), put_variable(y(3),2), call(load_math_expr/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(load_math_arg_lst/4)]). predicate(user:fast_exp_functor_name/3,664,static,private,monofile,global,[ switch_on_term(3,1,fail,fail,fail), label(1), switch_on_atom([((-),2),(inc,6),(dec,8),((+),10),((*),14),((//),16),((rem),18),((mod),20),((div),22),((/\),24),((\/),26),(xor,28),((\),30),((<<),32),((>>),34),(lsb,36),(msb,38),(popcount,40),(abs,42),(sign,44),(gcd,46),((^),48)]), label(2), try(4), trust(12), label(3), try_me_else(5), label(4), get_atom(-,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Neg',2), proceed, label(5), retry_me_else(7), label(6), get_atom(inc,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Inc',2), proceed, label(7), retry_me_else(9), label(8), get_atom(dec,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Dec',2), proceed, label(9), retry_me_else(11), label(10), get_atom(+,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Add',2), proceed, label(11), retry_me_else(13), label(12), get_atom(-,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Sub',2), proceed, label(13), retry_me_else(15), label(14), get_atom(*,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Mul',2), proceed, label(15), retry_me_else(17), label(16), get_atom(//,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Div',2), proceed, label(17), retry_me_else(19), label(18), get_atom(rem,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Rem',2), proceed, label(19), retry_me_else(21), label(20), get_atom(mod,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Mod',2), proceed, label(21), retry_me_else(23), label(22), get_atom(div,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Div2',2), proceed, label(23), retry_me_else(25), label(24), get_atom(/\,0), get_integer(2,1), get_atom('Pl_Fct_Fast_And',2), proceed, label(25), retry_me_else(27), label(26), get_atom(\/,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Or',2), proceed, label(27), retry_me_else(29), label(28), get_atom(xor,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Xor',2), proceed, label(29), retry_me_else(31), label(30), get_atom(\,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Not',2), proceed, label(31), retry_me_else(33), label(32), get_atom(<<,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Shl',2), proceed, label(33), retry_me_else(35), label(34), get_atom(>>,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Shr',2), proceed, label(35), retry_me_else(37), label(36), get_atom(lsb,0), get_integer(1,1), get_atom('Pl_Fct_Fast_LSB',2), proceed, label(37), retry_me_else(39), label(38), get_atom(msb,0), get_integer(1,1), get_atom('Pl_Fct_Fast_MSB',2), proceed, label(39), retry_me_else(41), label(40), get_atom(popcount,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Popcount',2), proceed, label(41), retry_me_else(43), label(42), get_atom(abs,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Abs',2), proceed, label(43), retry_me_else(45), label(44), get_atom(sign,0), get_integer(1,1), get_atom('Pl_Fct_Fast_Sign',2), proceed, label(45), retry_me_else(47), label(46), get_atom(gcd,0), get_integer(2,1), get_atom('Pl_Fct_Fast_GCD',2), proceed, label(47), trust_me_else_fail, label(48), get_atom(^,0), get_integer(2,1), get_atom('Pl_Fct_Fast_Integer_Pow',2), proceed]). predicate(user:math_exp_functor_name/3,690,static,private,monofile,global,[ switch_on_term(4,1,fail,fail,fail), label(1), switch_on_atom([((-),2), (inc,7), (dec,9), ((+),11), ((*),15), ((//),17), ((/),19), ((rem),21), ((mod),23), ((div),25), ((/\),27), ((\/),29), (xor,31), ((\),33), ((<<),35), ((>>),37), (lsb,39), (msb,41), (popcount,43), (abs,45), (sign,47), (gcd,49), (min,51), (max,53), ((^),55), ((**),57), (sqrt,59), (tan,61), (atan,63), (atan2,65), (cos,67), (acos,69), (sin,71), (asin,73), (tanh,75), (atanh,77), (cosh,79), (acosh,81), (sinh,83), (asinh,85), (exp,87), (log,3), (log10,91), (float,95), (ceiling,97), (floor,99), (round,101), (truncate,103), (float_fractional_part,105), (float_integer_part,107), (pi,109), (e,111), (epsilon,113)]), label(2), try(5), trust(13), label(3), try(89), trust(93), label(4), try_me_else(6), label(5), get_atom(-,0), get_integer(1,1), get_atom('Pl_Fct_Neg',2), proceed, label(6), retry_me_else(8), label(7), get_atom(inc,0), get_integer(1,1), get_atom('Pl_Fct_Inc',2), proceed, label(8), retry_me_else(10), label(9), get_atom(dec,0), get_integer(1,1), get_atom('Pl_Fct_Dec',2), proceed, label(10), retry_me_else(12), label(11), get_atom(+,0), get_integer(2,1), get_atom('Pl_Fct_Add',2), proceed, label(12), retry_me_else(14), label(13), get_atom(-,0), get_integer(2,1), get_atom('Pl_Fct_Sub',2), proceed, label(14), retry_me_else(16), label(15), get_atom(*,0), get_integer(2,1), get_atom('Pl_Fct_Mul',2), proceed, label(16), retry_me_else(18), label(17), get_atom(//,0), get_integer(2,1), get_atom('Pl_Fct_Div',2), proceed, label(18), retry_me_else(20), label(19), get_atom(/,0), get_integer(2,1), get_atom('Pl_Fct_Float_Div',2), proceed, label(20), retry_me_else(22), label(21), get_atom(rem,0), get_integer(2,1), get_atom('Pl_Fct_Rem',2), proceed, label(22), retry_me_else(24), label(23), get_atom(mod,0), get_integer(2,1), get_atom('Pl_Fct_Mod',2), proceed, label(24), retry_me_else(26), label(25), get_atom(div,0), get_integer(2,1), get_atom('Pl_Fct_Div2',2), proceed, label(26), retry_me_else(28), label(27), get_atom(/\,0), get_integer(2,1), get_atom('Pl_Fct_And',2), proceed, label(28), retry_me_else(30), label(29), get_atom(\/,0), get_integer(2,1), get_atom('Pl_Fct_Or',2), proceed, label(30), retry_me_else(32), label(31), get_atom(xor,0), get_integer(2,1), get_atom('Pl_Fct_Xor',2), proceed, label(32), retry_me_else(34), label(33), get_atom(\,0), get_integer(1,1), get_atom('Pl_Fct_Not',2), proceed, label(34), retry_me_else(36), label(35), get_atom(<<,0), get_integer(2,1), get_atom('Pl_Fct_Shl',2), proceed, label(36), retry_me_else(38), label(37), get_atom(>>,0), get_integer(2,1), get_atom('Pl_Fct_Shr',2), proceed, label(38), retry_me_else(40), label(39), get_atom(lsb,0), get_integer(1,1), get_atom('Pl_Fct_LSB',2), proceed, label(40), retry_me_else(42), label(41), get_atom(msb,0), get_integer(1,1), get_atom('Pl_Fct_MSB',2), proceed, label(42), retry_me_else(44), label(43), get_atom(popcount,0), get_integer(1,1), get_atom('Pl_Fct_Popcount',2), proceed, label(44), retry_me_else(46), label(45), get_atom(abs,0), get_integer(1,1), get_atom('Pl_Fct_Abs',2), proceed, label(46), retry_me_else(48), label(47), get_atom(sign,0), get_integer(1,1), get_atom('Pl_Fct_Sign',2), proceed, label(48), retry_me_else(50), label(49), get_atom(gcd,0), get_integer(2,1), get_atom('Pl_Fct_GCD',2), proceed, label(50), retry_me_else(52), label(51), get_atom(min,0), get_integer(2,1), get_atom('Pl_Fct_Min',2), proceed, label(52), retry_me_else(54), label(53), get_atom(max,0), get_integer(2,1), get_atom('Pl_Fct_Max',2), proceed, label(54), retry_me_else(56), label(55), get_atom(^,0), get_integer(2,1), get_atom('Pl_Fct_Integer_Pow',2), proceed, label(56), retry_me_else(58), label(57), get_atom(**,0), get_integer(2,1), get_atom('Pl_Fct_Pow',2), proceed, label(58), retry_me_else(60), label(59), get_atom(sqrt,0), get_integer(1,1), get_atom('Pl_Fct_Sqrt',2), proceed, label(60), retry_me_else(62), label(61), get_atom(tan,0), get_integer(1,1), get_atom('Pl_Fct_Tan',2), proceed, label(62), retry_me_else(64), label(63), get_atom(atan,0), get_integer(1,1), get_atom('Pl_Fct_Atan',2), proceed, label(64), retry_me_else(66), label(65), get_atom(atan2,0), get_integer(2,1), get_atom('Pl_Fct_Atan2',2), proceed, label(66), retry_me_else(68), label(67), get_atom(cos,0), get_integer(1,1), get_atom('Pl_Fct_Cos',2), proceed, label(68), retry_me_else(70), label(69), get_atom(acos,0), get_integer(1,1), get_atom('Pl_Fct_Acos',2), proceed, label(70), retry_me_else(72), label(71), get_atom(sin,0), get_integer(1,1), get_atom('Pl_Fct_Sin',2), proceed, label(72), retry_me_else(74), label(73), get_atom(asin,0), get_integer(1,1), get_atom('Pl_Fct_Asin',2), proceed, label(74), retry_me_else(76), label(75), get_atom(tanh,0), get_integer(1,1), get_atom('Pl_Fct_Tanh',2), proceed, label(76), retry_me_else(78), label(77), get_atom(atanh,0), get_integer(1,1), get_atom('Pl_Fct_Atanh',2), proceed, label(78), retry_me_else(80), label(79), get_atom(cosh,0), get_integer(1,1), get_atom('Pl_Fct_Cosh',2), proceed, label(80), retry_me_else(82), label(81), get_atom(acosh,0), get_integer(1,1), get_atom('Pl_Fct_Acosh',2), proceed, label(82), retry_me_else(84), label(83), get_atom(sinh,0), get_integer(1,1), get_atom('Pl_Fct_Sinh',2), proceed, label(84), retry_me_else(86), label(85), get_atom(asinh,0), get_integer(1,1), get_atom('Pl_Fct_Asinh',2), proceed, label(86), retry_me_else(88), label(87), get_atom(exp,0), get_integer(1,1), get_atom('Pl_Fct_Exp',2), proceed, label(88), retry_me_else(90), label(89), get_atom(log,0), get_integer(1,1), get_atom('Pl_Fct_Log',2), proceed, label(90), retry_me_else(92), label(91), get_atom(log10,0), get_integer(1,1), get_atom('Pl_Fct_Log10',2), proceed, label(92), retry_me_else(94), label(93), get_atom(log,0), get_integer(2,1), get_atom('Pl_Fct_Log_Radix',2), proceed, label(94), retry_me_else(96), label(95), get_atom(float,0), get_integer(1,1), get_atom('Pl_Fct_Float',2), proceed, label(96), retry_me_else(98), label(97), get_atom(ceiling,0), get_integer(1,1), get_atom('Pl_Fct_Ceiling',2), proceed, label(98), retry_me_else(100), label(99), get_atom(floor,0), get_integer(1,1), get_atom('Pl_Fct_Floor',2), proceed, label(100), retry_me_else(102), label(101), get_atom(round,0), get_integer(1,1), get_atom('Pl_Fct_Round',2), proceed, label(102), retry_me_else(104), label(103), get_atom(truncate,0), get_integer(1,1), get_atom('Pl_Fct_Truncate',2), proceed, label(104), retry_me_else(106), label(105), get_atom(float_fractional_part,0), get_integer(1,1), get_atom('Pl_Fct_Float_Fract_Part',2), proceed, label(106), retry_me_else(108), label(107), get_atom(float_integer_part,0), get_integer(1,1), get_atom('Pl_Fct_Float_Integ_Part',2), proceed, label(108), retry_me_else(110), label(109), get_atom(pi,0), get_integer(0,1), get_atom('Pl_Fct_PI',2), proceed, label(110), retry_me_else(112), label(111), get_atom(e,0), get_integer(0,1), get_atom('Pl_Fct_E',2), proceed, label(112), trust_me_else_fail, label(113), get_atom(epsilon,0), get_integer(0,1), get_atom('Pl_Fct_Epsilon',2), proceed]). predicate(user:fast_cmp_functor_name/2,761,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([((=:=),3),((=\=),5),((<),7),((=<),9),((>),11),((>=),13)]), label(2), try_me_else(4), label(3), get_atom(=:=,0), get_atom('Pl_Blt_Fast_Eq',1), proceed, label(4), retry_me_else(6), label(5), get_atom(=\=,0), get_atom('Pl_Blt_Fast_Neq',1), proceed, label(6), retry_me_else(8), label(7), get_atom(<,0), get_atom('Pl_Blt_Fast_Lt',1), proceed, label(8), retry_me_else(10), label(9), get_atom(=<,0), get_atom('Pl_Blt_Fast_Lte',1), proceed, label(10), retry_me_else(12), label(11), get_atom(>,0), get_atom('Pl_Blt_Fast_Gt',1), proceed, label(12), trust_me_else_fail, label(13), get_atom(>=,0), get_atom('Pl_Blt_Fast_Gte',1), proceed]). predicate(user:math_cmp_functor_name/2,768,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([((=:=),3),((=\=),5),((<),7),((=<),9),((>),11),((>=),13)]), label(2), try_me_else(4), label(3), get_atom(=:=,0), get_atom('Pl_Blt_Eq',1), proceed, label(4), retry_me_else(6), label(5), get_atom(=\=,0), get_atom('Pl_Blt_Neq',1), proceed, label(6), retry_me_else(8), label(7), get_atom(<,0), get_atom('Pl_Blt_Lt',1), proceed, label(8), retry_me_else(10), label(9), get_atom(=<,0), get_atom('Pl_Blt_Lte',1), proceed, label(10), retry_me_else(12), label(11), get_atom(>,0), get_atom('Pl_Blt_Gt',1), proceed, label(12), trust_me_else_fail, label(13), get_atom(>=,0), get_atom('Pl_Blt_Gte',1), proceed]). predicate(user:load_c_call_args/5,789,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), put_value(x(0),1), put_atom(by_value,0), call(memberchk/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), call(load_by_value_arg_lst/4), cut(y(4)), deallocate, proceed, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),5), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), call(load_by_reg_arg_lst/4), cut(y(0)), deallocate, proceed]). predicate(user:load_by_reg_arg_lst/4,800,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), get_structure(x/1,1), unify_variable(x(1)), put_variable(y(3),2), call(gen_load_arg/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(load_by_reg_arg_lst/4)]). predicate(user:load_by_value_arg_lst/4,809,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_value(x(3),2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(1)), unify_variable(y(1)), put_variable(y(3),2), call(load_by_value_arg/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute(load_by_value_arg_lst/4)]). predicate(user:load_by_value_arg/4,816,static,private,monofile,global,[ try_me_else(12), switch_on_term(2,9,fail,fail,1), label(1), switch_on_structure([(atm/1,3),(int/1,5),(flt/1,7),(stc/3,11)]), label(2), try_me_else(4), label(3), get_value(x(3),2), get_structure(atm/1,0), unify_local_value(x(1)), proceed, label(4), retry_me_else(6), label(5), get_value(x(3),2), get_structure(int/1,0), unify_local_value(x(1)), proceed, label(6), retry_me_else(8), label(7), get_value(x(3),2), get_structure(flt/1,0), unify_local_value(x(1)), proceed, label(8), retry_me_else(10), label(9), get_atom(nil,0), get_nil(1), get_value(x(3),2), proceed, label(10), trust_me_else_fail, label(11), get_value(x(3),2), get_structure(stc/3,0), unify_atom(/), unify_integer(2), unify_list, unify_variable(x(2)), unify_list, unify_variable(x(0)), unify_nil, get_structure(atm/1,2), unify_variable(x(2)), get_structure(int/1,0), unify_variable(x(0)), get_structure((/)/2,1), unify_value(x(2)), unify_value(x(0)), proceed, label(12), trust_me_else_fail, get_structure(x/1,1), unify_variable(x(1)), execute(gen_load_arg/4)]). predicate(user:c_fct_name/4,846,static,private,monofile,global,[ switch_on_term(4,1,fail,fail,fail), label(1), switch_on_atom([(var,5), (nonvar,7), (atom,9), (integer,11), (float,13), (number,15), (atomic,17), (compound,19), (callable,21), (ground,23), (is_list,25), (list,27), (partial_list,29), (list_or_partial_list,31), (fd_var,33), (non_fd_var,35), (generic_var,37), (non_generic_var,39), (arg,41), (functor,43), (compare,45), ((=..),47), ((==),49), ((\==),51), ((@<),53), ((@=<),55), ((@>),57), ((@>=),59), (g_assign,61), (g_assignb,63), (g_link,65), (g_read,67), (g_array_size,69), (g_inc,2), (g_inco,73), (g_dec,3), (g_deco,81), (g_set_bit,87), (g_reset_bit,89), (g_test_set_bit,91), (g_test_reset_bit,93)]), label(2), try(71), retry(75), trust(77), label(3), try(79), retry(83), trust(85), label(4), try_me_else(6), label(5), get_atom(var,0), get_integer(1,1), get_atom('Pl_Blt_Var',2), get_atom(bool,3), proceed, label(6), retry_me_else(8), label(7), get_atom(nonvar,0), get_integer(1,1), get_atom('Pl_Blt_Non_Var',2), get_atom(bool,3), proceed, label(8), retry_me_else(10), label(9), get_atom(atom,0), get_integer(1,1), get_atom('Pl_Blt_Atom',2), get_atom(bool,3), proceed, label(10), retry_me_else(12), label(11), get_atom(integer,0), get_integer(1,1), get_atom('Pl_Blt_Integer',2), get_atom(bool,3), proceed, label(12), retry_me_else(14), label(13), get_atom(float,0), get_integer(1,1), get_atom('Pl_Blt_Float',2), get_atom(bool,3), proceed, label(14), retry_me_else(16), label(15), get_atom(number,0), get_integer(1,1), get_atom('Pl_Blt_Number',2), get_atom(bool,3), proceed, label(16), retry_me_else(18), label(17), get_atom(atomic,0), get_integer(1,1), get_atom('Pl_Blt_Atomic',2), get_atom(bool,3), proceed, label(18), retry_me_else(20), label(19), get_atom(compound,0), get_integer(1,1), get_atom('Pl_Blt_Compound',2), get_atom(bool,3), proceed, label(20), retry_me_else(22), label(21), get_atom(callable,0), get_integer(1,1), get_atom('Pl_Blt_Callable',2), get_atom(bool,3), proceed, label(22), retry_me_else(24), label(23), get_atom(ground,0), get_integer(1,1), get_atom('Pl_Blt_Ground',2), get_atom(bool,3), proceed, label(24), retry_me_else(26), label(25), get_atom(is_list,0), get_integer(1,1), get_atom('Pl_Blt_List',2), get_atom(bool,3), proceed, label(26), retry_me_else(28), label(27), get_atom(list,0), get_integer(1,1), get_atom('Pl_Blt_List',2), get_atom(bool,3), proceed, label(28), retry_me_else(30), label(29), get_atom(partial_list,0), get_integer(1,1), get_atom('Pl_Blt_Partial_List',2), get_atom(bool,3), proceed, label(30), retry_me_else(32), label(31), get_atom(list_or_partial_list,0), get_integer(1,1), get_atom('Pl_Blt_List_Or_Partial_List',2), get_atom(bool,3), proceed, label(32), retry_me_else(34), label(33), get_atom(fd_var,0), get_integer(1,1), get_atom('Pl_Blt_Fd_Var',2), get_atom(bool,3), proceed, label(34), retry_me_else(36), label(35), get_atom(non_fd_var,0), get_integer(1,1), get_atom('Pl_Blt_Non_Fd_Var',2), get_atom(bool,3), proceed, label(36), retry_me_else(38), label(37), get_atom(generic_var,0), get_integer(1,1), get_atom('Pl_Blt_Generic_Var',2), get_atom(bool,3), proceed, label(38), retry_me_else(40), label(39), get_atom(non_generic_var,0), get_integer(1,1), get_atom('Pl_Blt_Non_Generic_Var',2), get_atom(bool,3), proceed, label(40), retry_me_else(42), label(41), get_atom(arg,0), get_integer(3,1), get_atom('Pl_Blt_Arg',2), get_atom(bool,3), proceed, label(42), retry_me_else(44), label(43), get_atom(functor,0), get_integer(3,1), get_atom('Pl_Blt_Functor',2), get_atom(bool,3), proceed, label(44), retry_me_else(46), label(45), get_atom(compare,0), get_integer(3,1), get_atom('Pl_Blt_Compare',2), get_atom(bool,3), proceed, label(46), retry_me_else(48), label(47), get_atom(=..,0), get_integer(2,1), get_atom('Pl_Blt_Univ',2), get_atom(bool,3), proceed, label(48), retry_me_else(50), label(49), get_atom(==,0), get_integer(2,1), get_atom('Pl_Blt_Term_Eq',2), get_atom(bool,3), proceed, label(50), retry_me_else(52), label(51), get_atom(\==,0), get_integer(2,1), get_atom('Pl_Blt_Term_Neq',2), get_atom(bool,3), proceed, label(52), retry_me_else(54), label(53), get_atom(@<,0), get_integer(2,1), get_atom('Pl_Blt_Term_Lt',2), get_atom(bool,3), proceed, label(54), retry_me_else(56), label(55), get_atom(@=<,0), get_integer(2,1), get_atom('Pl_Blt_Term_Lte',2), get_atom(bool,3), proceed, label(56), retry_me_else(58), label(57), get_atom(@>,0), get_integer(2,1), get_atom('Pl_Blt_Term_Gt',2), get_atom(bool,3), proceed, label(58), retry_me_else(60), label(59), get_atom(@>=,0), get_integer(2,1), get_atom('Pl_Blt_Term_Gte',2), get_atom(bool,3), proceed, label(60), retry_me_else(62), label(61), get_atom(g_assign,0), get_integer(2,1), get_atom('Pl_Blt_G_Assign',2), get_atom(void,3), proceed, label(62), retry_me_else(64), label(63), get_atom(g_assignb,0), get_integer(2,1), get_atom('Pl_Blt_G_Assignb',2), get_atom(void,3), proceed, label(64), retry_me_else(66), label(65), get_atom(g_link,0), get_integer(2,1), get_atom('Pl_Blt_G_Link',2), get_atom(void,3), proceed, label(66), retry_me_else(68), label(67), get_atom(g_read,0), get_integer(2,1), get_atom('Pl_Blt_G_Read',2), get_atom(bool,3), proceed, label(68), retry_me_else(70), label(69), get_atom(g_array_size,0), get_integer(2,1), get_atom('Pl_Blt_G_Array_Size',2), get_atom(bool,3), proceed, label(70), retry_me_else(72), label(71), get_atom(g_inc,0), get_integer(1,1), get_atom('Pl_Blt_G_Inc',2), get_atom(void,3), proceed, label(72), retry_me_else(74), label(73), get_atom(g_inco,0), get_integer(2,1), get_atom('Pl_Blt_G_Inco',2), get_atom(bool,3), proceed, label(74), retry_me_else(76), label(75), get_atom(g_inc,0), get_integer(2,1), get_atom('Pl_Blt_G_Inc_2',2), get_atom(bool,3), proceed, label(76), retry_me_else(78), label(77), get_atom(g_inc,0), get_integer(3,1), get_atom('Pl_Blt_G_Inc_3',2), get_atom(bool,3), proceed, label(78), retry_me_else(80), label(79), get_atom(g_dec,0), get_integer(1,1), get_atom('Pl_Blt_G_Dec',2), get_atom(void,3), proceed, label(80), retry_me_else(82), label(81), get_atom(g_deco,0), get_integer(2,1), get_atom('Pl_Blt_G_Deco',2), get_atom(bool,3), proceed, label(82), retry_me_else(84), label(83), get_atom(g_dec,0), get_integer(2,1), get_atom('Pl_Blt_G_Dec_2',2), get_atom(bool,3), proceed, label(84), retry_me_else(86), label(85), get_atom(g_dec,0), get_integer(3,1), get_atom('Pl_Blt_G_Dec_3',2), get_atom(bool,3), proceed, label(86), retry_me_else(88), label(87), get_atom(g_set_bit,0), get_integer(2,1), get_atom('Pl_Blt_G_Set_Bit',2), get_atom(void,3), proceed, label(88), retry_me_else(90), label(89), get_atom(g_reset_bit,0), get_integer(2,1), get_atom('Pl_Blt_G_Reset_Bit',2), get_atom(void,3), proceed, label(90), retry_me_else(92), label(91), get_atom(g_test_set_bit,0), get_integer(2,1), get_atom('Pl_Blt_G_Test_Set_Bit',2), get_atom(bool,3), proceed, label(92), trust_me_else_fail, label(93), get_atom(g_test_reset_bit,0), get_integer(2,1), get_atom('Pl_Blt_G_Test_Reset_Bit',2), get_atom(bool,3), proceed]). predicate(user:gen_inline_pred/5,476,static,private,monofile,global,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(14), switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([('$get_cut_level',3),('$get_current_choice',5),('$cut',7),('$soft_cut',9),((=),11),((is),13)]), label(2), try_me_else(4), label(3), allocate(5), get_atom('$get_cut_level',0), get_integer(1,1), get_list(2), unify_variable(y(0)), unify_nil, get_variable(y(1),3), get_variable(y(2),4), put_variable(y(3),0), put_variable(y(4),1), call(cur_pred/2), put_atom(cut,0), put_value(y(3),1), put_value(y(4),2), call(set_pred_info/3), put_value(y(0),0), put_unsafe_value(y(4),1), put_value(y(1),2), put_value(y(2),3), deallocate, execute(gen_unif_arg/4), label(4), retry_me_else(6), label(5), get_atom('$get_current_choice',0), get_integer(1,1), get_list(2), unify_variable(x(0)), unify_nil, get_structure(var/2,0), unify_variable(x(0)), unify_void(1), get_list(4), unify_variable(x(1)), unify_local_value(x(3)), get_structure(get_current_choice/1,1), unify_value(x(0)), proceed, label(6), retry_me_else(8), label(7), get_atom('$cut',0), get_integer(1,1), get_list(2), unify_variable(x(0)), unify_nil, get_structure(var/2,0), unify_variable(x(0)), unify_void(1), get_list(4), unify_variable(x(1)), unify_local_value(x(3)), get_structure(cut/1,1), unify_value(x(0)), proceed, label(8), retry_me_else(10), label(9), get_atom('$soft_cut',0), get_integer(1,1), get_list(2), unify_variable(x(0)), unify_nil, get_structure(var/2,0), unify_variable(x(0)), unify_void(1), get_list(4), unify_variable(x(1)), unify_local_value(x(3)), get_structure(soft_cut/1,1), unify_value(x(0)), proceed, label(10), retry_me_else(12), label(11), allocate(1), get_atom(=,0), get_integer(2,1), get_list(2), unify_variable(x(0)), unify_list, unify_variable(x(1)), unify_nil, get_variable(y(0),5), put_value(x(3),2), put_value(x(4),3), call(equal/4), cut(y(0)), deallocate, proceed, label(12), trust_me_else_fail, label(13), allocate(5), get_atom(is,0), get_integer(2,1), get_variable(y(1),3), get_list(2), unify_variable(y(0)), unify_list, unify_variable(x(0)), unify_nil, get_variable(y(2),5), put_value(x(4),3), put_variable(y(3),1), put_variable(y(4),2), call(load_math_expr/4), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), put_value(y(1),2), put_unsafe_value(y(4),3), deallocate, execute(gen_unif_arg/4), label(14), retry_me_else(15), allocate(6), get_integer(2,1), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), put_variable(y(3),1), call('$gen_inline_pred/5_$aux1'/2), put_value(y(0),0), put_variable(y(4),1), put_variable(y(5),2), put_value(y(2),3), call(load_math_arg_lst/4), put_unsafe_value(y(5),0), get_list(0), unify_variable(x(0)), unify_local_value(y(1)), get_structure(call_c/3,0), unify_local_value(y(3)), unify_variable(x(0)), unify_local_value(y(4)), get_list(0), unify_atom(fast_call), unify_list, unify_atom(boolean), unify_nil, deallocate, proceed, label(15), retry_me_else(16), get_atom('$foreign_call_c',0), get_integer(1,1), get_list(2), unify_variable(x(0)), unify_nil, get_structure(args/5,0), unify_variable(x(6)), unify_variable(x(5)), unify_variable(x(2)), unify_variable(x(1)), unify_variable(x(0)), get_list(4), unify_variable(x(4)), unify_local_value(x(3)), get_structure(foreign_call_c/5,4), unify_value(x(6)), unify_value(x(5)), unify_value(x(2)), unify_value(x(1)), unify_value(x(0)), proceed, label(16), trust_me_else_fail, allocate(8), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), put_variable(y(3),2), put_variable(y(4),3), call(c_fct_name/4), put_value(y(4),0), put_variable(y(5),1), call('$gen_inline_pred/5_$aux2'/2), put_value(y(5),0), put_value(y(0),1), put_variable(y(6),2), put_variable(y(7),3), put_value(y(2),4), call(load_c_call_args/5), put_unsafe_value(y(7),0), get_list(0), unify_variable(x(0)), unify_local_value(y(1)), get_structure(call_c/3,0), unify_local_value(y(3)), unify_local_value(y(5)), unify_local_value(y(6)), deallocate, proceed]). predicate(user:'$gen_inline_pred/5_$aux2'/2,834,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(bool,0), cut(x(2)), get_list(1), unify_atom(fast_call), unify_list, unify_atom(boolean), unify_nil, proceed, label(1), trust_me_else_fail, get_list(1), unify_atom(fast_call), unify_nil, proceed]). predicate(user:'$gen_inline_pred/5_$aux1'/2,750,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(fast_math,3), put_atom(t,4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(3),x(4)]), cut(x(2)), execute(fast_cmp_functor_name/2), label(1), trust_me_else_fail, execute(math_cmp_functor_name/2)]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/first_arg.wam��������������������������������������������������������������0000644�0001750�0001750�00000007364�13021356407�015714� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : first_arg.pl file_name('/home/diaz/GP/src/Pl2Wam/first_arg.pl'). predicate(user:find_first_arg/2,39,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_atom(var,1), proceed, label(3), trust_me_else_fail, label(4), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(x(3)), get_variable(y(0),2), put_value(x(3),2), call('$find_first_arg/2_$aux1'/3), cut(y(0)), deallocate, proceed]). predicate(user:'$find_first_arg/2_$aux1'/3,41,static,private,monofile,local,[ try_me_else(1), execute(defines_first_arg/2), label(1), retry_me_else(2), allocate(1), get_variable(y(0),1), call(stopping_inst/1), put_value(y(0),0), get_atom(var,0), deallocate, proceed, label(2), trust_me_else_fail, put_value(x(2),0), execute(find_first_arg/2)]). predicate(user:stopping_inst/1,51,static,private,monofile,global,[ try_me_else(10), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(call/1,3),(execute/1,5),(cut/1,7),(soft_cut/1,9)]), label(2), try_me_else(4), label(3), get_structure(call/1,0), unify_void(1), proceed, label(4), retry_me_else(6), label(5), get_structure(execute/1,0), unify_void(1), proceed, label(6), retry_me_else(8), label(7), get_structure(cut/1,0), unify_void(1), proceed, label(8), trust_me_else_fail, label(9), get_structure(soft_cut/1,0), unify_void(1), proceed, label(10), trust_me_else_fail, allocate(1), put_variable(y(0),1), call(codification/2), put_unsafe_value(y(0),0), deallocate, execute(assign_x0/1)]). predicate(user:assign_x0/1,66,static,private,monofile,global,[ get_list(0), unify_variable(x(0)), unify_variable(x(1)), execute('$assign_x0/1_$aux1'/2)]). predicate(user:'$assign_x0/1_$aux1'/2,66,static,private,monofile,local,[ try_me_else(6), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(w/1,3),(c/2,5)]), label(2), try_me_else(4), label(3), get_structure(w/1,0), unify_integer(0), proceed, label(4), trust_me_else_fail, label(5), get_structure(c/2,0), unify_variable(x(1)), unify_variable(x(0)), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), get_integer(0,0), proceed, label(6), trust_me_else_fail, put_value(x(1),0), execute(assign_x0/1)]). predicate(user:defines_first_arg/2,77,static,private,monofile,global,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(get_atom/2,3),(get_integer/2,5),(get_nil/1,7),(get_list/1,9),(get_structure/2,11)]), label(2), try_me_else(4), label(3), get_structure(get_atom/2,0), unify_variable(x(0)), unify_integer(0), get_structure(atm/1,1), unify_value(x(0)), proceed, label(4), retry_me_else(6), label(5), get_structure(get_integer/2,0), unify_variable(x(0)), unify_integer(0), get_structure(int/1,1), unify_value(x(0)), proceed, label(6), retry_me_else(8), label(7), get_structure(get_nil/1,0), unify_integer(0), get_structure(atm/1,1), unify_nil, proceed, label(8), retry_me_else(10), label(9), get_structure(get_list/1,0), unify_integer(0), get_atom(lst,1), proceed, label(10), trust_me_else_fail, label(11), get_structure(get_structure/2,0), unify_variable(x(0)), unify_integer(0), get_structure((/)/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(stc/2,1), unify_value(x(2)), unify_value(x(0)), proceed]). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/boot_cp��������������������������������������������������������������������0000755�0001750�0001750�00000000111�13021324543�014554� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh files=${*:-*.wam} for i in $files; do \cp $i ${i}1 done �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/sics_pl2wam����������������������������������������������������������������0000755�0001750�0001750�00000000043�13021324543�015356� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh sicstus -l sicstus -a $* ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/inst_codif.wam�������������������������������������������������������������0000644�0001750�0001750�00000041104�13021356407�016043� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : inst_codif.pl file_name('/home/diaz/GP/src/Pl2Wam/inst_codif.pl'). predicate(user:alias_stop_instruction/1,41,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), allocate(1), get_variable(x(2),0), get_variable(y(0),1), put_variable(x(0),1), put_void(3), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(2),x(1),x(3)]), put_value(x(2),1), call('$alias_stop_instruction/1_$aux1'/2), cut(y(0)), deallocate, proceed]). predicate(user:'$alias_stop_instruction/1_$aux1'/2,41,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(call,3),(execute,5),(call_c,7)]), label(2), try_me_else(4), label(3), get_atom(call,0), proceed, label(4), retry_me_else(6), label(5), get_atom(execute,0), proceed, label(6), trust_me_else_fail, label(7), get_atom(call_c,0), put_integer(2,2), put_variable(x(0),3), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(2),x(1),x(3)]), execute('$alias_stop_instruction/1_$aux2'/1)]). predicate(user:'$alias_stop_instruction/1_$aux2'/1,41,static,private,monofile,local,[ try_me_else(1), put_value(x(0),1), put_atom(jump,0), execute(memberchk/2), label(1), trust_me_else_fail, put_value(x(0),1), put_atom(use_x_args,0), execute(memberchk/2)]). predicate(user:codification/2,55,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), allocate(1), get_variable(y(0),2), call(codif/2), cut(y(0)), deallocate, proceed]). predicate(user:codif/2,59,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(82), switch_on_term(8,fail,fail,fail,1), label(1), switch_on_structure([(get_variable/2,2),(get_value/2,3),(get_atom/2,17),(get_integer/2,19),(get_float/2,21),(get_nil/1,23),(get_list/1,25),(get_structure/2,27),(put_variable/2,4),(put_void/1,31),(put_value/2,5),(put_unsafe_value/2,39),(put_atom/2,41),(put_integer/2,43),(put_float/2,45),(put_nil/1,47),(put_list/1,49),(put_structure/2,51),(put_meta_term/3,53),(math_load_value/2,6),(math_fast_load_value/2,7),(unify_variable/1,63),(unify_value/1,65),(unify_local_value/1,67),(call/1,69),(execute/1,71),(get_current_choice/1,73),(cut/1,75),(soft_cut/1,77),(call_c/3,79),(foreign_call_c/4,81)]), label(2), try(9), trust(13), label(3), try(11), trust(15), label(4), try(29), trust(35), label(5), try(33), trust(37), label(6), try(55), trust(57), label(7), try(59), trust(61), label(8), try_me_else(10), label(9), get_structure(get_variable/2,0), unify_variable(x(0)), unify_variable(x(2)), get_structure(x/1,0), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(c/2,1), unify_value(x(2)), unify_value(x(0)), proceed, label(10), retry_me_else(12), label(11), get_structure(get_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(x/1,2), unify_variable(x(2)), get_list(1), unify_variable(x(3)), unify_list, unify_variable(x(1)), unify_nil, get_structure(r/1,3), unify_value(x(2)), get_structure(r/1,1), unify_value(x(0)), proceed, label(12), retry_me_else(14), label(13), get_structure(get_variable/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(14), retry_me_else(16), label(15), get_structure(get_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(16), retry_me_else(18), label(17), get_structure(get_atom/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(18), retry_me_else(20), label(19), get_structure(get_integer/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(20), retry_me_else(22), label(21), get_structure(get_float/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(22), retry_me_else(24), label(23), get_structure(get_nil/1,0), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(24), retry_me_else(26), label(25), get_structure(get_list/1,0), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(26), retry_me_else(28), label(27), get_structure(get_structure/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(28), retry_me_else(30), label(29), get_structure(put_variable/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(x/1,2), unify_variable(x(2)), get_list(1), unify_variable(x(3)), unify_list, unify_variable(x(1)), unify_nil, get_structure(w/1,3), unify_value(x(2)), get_structure(w/1,1), unify_value(x(0)), proceed, label(30), retry_me_else(32), label(31), get_structure(put_void/1,0), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(32), retry_me_else(34), label(33), get_structure(put_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(x/1,2), unify_variable(x(2)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(c/2,1), unify_value(x(2)), unify_value(x(0)), proceed, label(34), retry_me_else(36), label(35), get_structure(put_variable/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(36), retry_me_else(38), label(37), get_structure(put_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(38), retry_me_else(40), label(39), get_structure(put_unsafe_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(40), retry_me_else(42), label(41), get_structure(put_atom/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(42), retry_me_else(44), label(43), get_structure(put_integer/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(44), retry_me_else(46), label(45), get_structure(put_float/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(46), retry_me_else(48), label(47), get_structure(put_nil/1,0), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(48), retry_me_else(50), label(49), get_structure(put_list/1,0), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(50), retry_me_else(52), label(51), get_structure(put_structure/2,0), unify_void(1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(52), retry_me_else(54), label(53), get_structure(put_meta_term/3,0), unify_void(1), unify_variable(x(2)), unify_variable(x(0)), get_list(1), unify_variable(x(3)), unify_list, unify_variable(x(1)), unify_nil, get_structure(r/1,3), unify_value(x(2)), get_structure(w/1,1), unify_value(x(0)), proceed, label(54), retry_me_else(56), label(55), get_structure(math_load_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(x/1,2), unify_variable(x(2)), get_list(1), unify_variable(x(3)), unify_list, unify_variable(x(1)), unify_nil, get_structure(r/1,3), unify_value(x(2)), get_structure(w/1,1), unify_value(x(0)), proceed, label(56), retry_me_else(58), label(57), get_structure(math_load_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(58), retry_me_else(60), label(59), get_structure(math_fast_load_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(x/1,2), unify_variable(x(2)), get_list(1), unify_variable(x(3)), unify_list, unify_variable(x(1)), unify_nil, get_structure(r/1,3), unify_value(x(2)), get_structure(w/1,1), unify_value(x(0)), proceed, label(60), retry_me_else(62), label(61), get_structure(math_fast_load_value/2,0), unify_variable(x(2)), unify_variable(x(0)), get_structure(y/1,2), unify_void(1), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(62), retry_me_else(64), label(63), get_structure(unify_variable/1,0), unify_structure(x/1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(64), retry_me_else(66), label(65), get_structure(unify_value/1,0), unify_structure(x/1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(66), retry_me_else(68), label(67), get_structure(unify_local_value/1,0), unify_structure(x/1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(68), retry_me_else(70), label(69), allocate(3), get_variable(y(0),1), get_structure(call/1,0), unify_variable(x(0)), get_variable(y(1),2), put_variable(y(2),1), call('$codif/2_$aux1'/2), cut(y(1)), put_integer(0,0), put_unsafe_value(y(2),1), put_value(y(0),2), deallocate, execute(lst_r_for_call_execute/3), label(70), retry_me_else(72), label(71), allocate(3), get_variable(y(0),1), get_structure(execute/1,0), unify_variable(x(0)), get_variable(y(1),2), put_variable(y(2),1), call('$codif/2_$aux2'/2), cut(y(1)), put_integer(0,0), put_unsafe_value(y(2),1), put_value(y(0),2), deallocate, execute(lst_r_for_call_execute/3), label(72), retry_me_else(74), label(73), get_structure(get_current_choice/1,0), unify_structure(x/1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(w/1,1), unify_value(x(0)), proceed, label(74), retry_me_else(76), label(75), get_structure(cut/1,0), unify_structure(x/1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(76), retry_me_else(78), label(77), get_structure(soft_cut/1,0), unify_structure(x/1), unify_variable(x(0)), get_list(1), unify_variable(x(1)), unify_nil, get_structure(r/1,1), unify_value(x(0)), proceed, label(78), retry_me_else(80), label(79), allocate(3), get_variable(y(1),1), get_structure(call_c/3,0), unify_void(1), unify_variable(x(0)), unify_variable(y(0)), put_variable(y(2),1), call('$codif/2_$aux3'/2), put_value(y(0),0), put_unsafe_value(y(2),1), put_value(y(1),2), deallocate, execute(lst_rw_for_c_call/3), label(80), trust_me_else_fail, label(81), get_structure(foreign_call_c/4,0), unify_void(2), unify_variable(x(0)), unify_void(1), put_value(x(1),2), put_nil(1), execute(lst_rw_for_foreign_c_call/3), label(82), trust_me_else_fail, get_nil(1), proceed]). predicate(user:'$codif/2_$aux3'/2,133,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),1), get_variable(y(1),2), put_value(x(0),1), put_structure(x/1,0), unify_variable(y(2)), call(member/2), cut(y(1)), put_value(y(0),0), get_list(0), unify_variable(x(0)), unify_nil, get_structure(w/1,0), unify_value(y(2)), deallocate, proceed, label(1), trust_me_else_fail, get_nil(1), proceed]). predicate(user:'$codif/2_$aux2'/2,123,static,private,monofile,local,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([((/)/2,3),((:)/2,5)]), label(2), try_me_else(4), label(3), get_structure((/)/2,0), unify_void(1), unify_local_value(x(1)), proceed, label(4), trust_me_else_fail, label(5), get_structure((:)/2,0), unify_void(1), unify_structure((/)/2), unify_void(1), unify_local_value(x(1)), proceed]). predicate(user:'$codif/2_$aux1'/2,119,static,private,monofile,local,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([((/)/2,3),((:)/2,5)]), label(2), try_me_else(4), label(3), get_structure((/)/2,0), unify_void(1), unify_local_value(x(1)), proceed, label(4), trust_me_else_fail, label(5), get_structure((:)/2,0), unify_void(1), unify_structure((/)/2), unify_void(1), unify_local_value(x(1)), proceed]). predicate(user:lst_r_for_call_execute/3,150,static,private,monofile,global,[ try_me_else(1), get_nil(2), get_value(x(1),0), proceed, label(1), trust_me_else_fail, get_list(2), unify_variable(x(3)), unify_variable(x(2)), get_structure(r/1,3), unify_local_value(x(0)), math_fast_load_value(x(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), execute(lst_r_for_call_execute/3)]). predicate(user:lst_rw_for_foreign_c_call/3,159,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), proceed, label(3), trust_me_else_fail, label(4), get_variable(x(3),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_list(2), unify_variable(x(4)), unify_variable(x(2)), get_structure(r/1,4), unify_value(x(1)), put_structure(w/1,4), unify_value(x(1)), put_list(1), unify_value(x(4)), unify_local_value(x(3)), execute(lst_rw_for_foreign_c_call/3)]). predicate(user:lst_rw_for_c_call/3,167,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), proceed, label(4), retry_me_else(6), label(5), get_variable(x(4),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_structure(x/1,1), unify_variable(x(1)), get_list(2), unify_variable(x(5)), unify_variable(x(2)), get_structure(r/1,5), unify_value(x(1)), cut(x(3)), put_structure(w/1,3), unify_value(x(1)), put_list(1), unify_value(x(3)), unify_local_value(x(4)), execute(lst_rw_for_c_call/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_void(1), unify_variable(x(0)), execute(lst_rw_for_c_call/3)]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/internal.pl����������������������������������������������������������������0000644�0001750�0001750�00000027146�13021324543�015373� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : internal.pl * * Descr.: pass 2: internal format transformation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * predicate internal format: (I(t)=internal format of t) * * * * I(p(Arg1,..., ArgN)): p(NoPred, Module, Pred/N, [I(Arg1), ..., I(ArgN)])* * * * NoPred : predicate number = corresponding chunk number * * * * Module: module qualification or module owner if export (a variable else)* * used to qualify a call to a predicate (see code_gen.pl) * * * * Pred/N : predicate/arity * * * * I(Argi): internal format of the ith argument * * * * var : var(VarName, Info) with: * * VarName = x(NoX) temporary * * (here NoX is unbound or = void if var is singleton) * * y(NoY) permanent (NoY is assigned here) * * Info = in_heap : the var is stored in the heap * * unsafe : the var refers current environment * * not_in_cur_env: the var does not reside in the * * current environment * * (here Info is unbound) * * * * atom [] : nil * * atom (others) : atm(atom) * * integer : int(integer) * * float : flt(float) * * f(A1, ..., An): stc(f, n, [I(A1), ..., I(An)]) ([H|T] = '.'(H, T)) * * * * NB: a true/0 in the body of a clause is removed. * * variables are classified and permanent variables are assigned * * (temporary = x(_), permanent = y(i)) * *-------------------------------------------------------------------------*/ internal_format(Head, Body, Head1, Body1, NbChunk, NbY) :- format_head(Head, DicoVar, Head1), format_body(Body, DicoVar, Body1, NbChunk), classif_vars(DicoVar, 0, NbY). format_head(Head, DicoVar, Head1) :- get_module_of_cur_pred(Module), % not really necessary since Module info of head is never used format_pred(Module:Head, 0, DicoVar, Head1, _). format_body(Body, DicoVar, Body1, NbChunk) :- format_body1(Body, 0, DicoVar, t, [], Body1, NbChunk, _). format_body1((P, Q), NoPred, DicoVar, StartChunk, LNext, P1, NoPred2, StartChunk2) :- !, format_body1(P, NoPred, DicoVar, StartChunk, Q1, P1, NoPred1, StartChunk1), format_body1(Q, NoPred1, DicoVar, StartChunk1, LNext, Q1, NoPred2, StartChunk2). format_body1(true, NoPred, _, StartChunk, LNext, LNext, NoPred, StartChunk) :- !. format_body1(Pred, NoPred, DicoVar, StartChunk, LNext, [Pred1|LNext], NoPred1, StartChunk1) :- ( StartChunk = t -> NoPred1 is NoPred + 1 ; NoPred1 = NoPred ), format_pred(Pred, NoPred1, DicoVar, Pred1, InlinePred), ( InlinePred = t -> StartChunk1 = f ; StartChunk1 = t ). % NB: a dangerous '$call_c' (e.g. with jump) is not considered as % inlined to enforce the end of its chunk. If something comes % after this '$call_c' an environment will be created (allocate) % to save CP (and X regs in Y regs if needed). % Other '$call_c' are considered as inlined. format_pred(Module:Pred, NoPred, DicoVar, p(NoPred, Module, FN, ArgLst), InlinePred) :- !, format_pred(Pred, NoPred, DicoVar, p(NoPred, _, FN, ArgLst), InlinePred). format_pred(Pred, NoPred, DicoVar, p(NoPred, Module, F1 / N, ArgLst1), InlinePred) :- functor(Pred, F, N), get_owner_module(F, N, Module, F1), % F1 is to handle as/2 in import Pred =.. [_|ArgLst], format_arg_lst(ArgLst, NoPred, DicoVar, ArgLst1), ( ( F = F1, inline_predicate(F, N) ; F = F1, F = '$call_c', N = 2, ArgLst1 = [_, LCOpt], % $no_internal_transf$ removed here not_dangerous_c_call(LCOpt) ) -> InlinePred = t ; InlinePred = f ). format_arg_lst([], _, _, []). format_arg_lst([Arg|ArgLst], NoPred, DicoVar, [Arg1|ArgLst1]) :- format_arg(Arg, NoPred, DicoVar, Arg1), !, format_arg_lst(ArgLst, NoPred, DicoVar, ArgLst1). format_arg(Var, NoPred, DicoVar, V) :- var(Var), add_var_to_dico(DicoVar, Var, NoPred, V). format_arg(T, _, _, T1) :- no_internal_transf(T1, T). format_arg([], _, _, nil). format_arg(A, _, _, atm(A)) :- atom(A). format_arg(N, _, _, int(N)) :- integer(N). format_arg(N, _, _, flt(N)) :- float(N). format_arg(Fonc, NoPred, DicoVar, stc(F, N, ArgLst1)) :- functor(Fonc, F, N), Fonc =.. [_|ArgLst], format_arg_lst(ArgLst, NoPred, DicoVar, ArgLst1). % creates a term T1 equivalent to T which will not be transformed % in the internal format. This can only by used for arguments of % inlined predicates and requires T is ground. % % NB: do not use T1 = '$no_internal_transf$'(T) for bootstrapping. no_internal_transf(T, T1) :- functor(T1, '$no_internal_tranf$', 1), arg(1, T1, T). % DicoVar=[ v(Var, NoPred1stOcc, Singleton, V), ... | EndVar ] % % Singleton = f or unbound variable % V = var(VarName, VarInfo) % VarName = x(_) or y(_) % Info is unbound add_var_to_dico(DicoVar, Var, NoPred1stOcc, V) :- var(DicoVar), !, V = var(_, _), DicoVar = [v(Var, NoPred1stOcc, _, V)|_]. add_var_to_dico([v(Var1, NoPred1stOcc1, Singleton, V)|_], Var2, NoPred1stOcc2, V) :- Var1 == Var2, !, V = var(VarName, _), Singleton = f, ( var(VarName), NoPred1stOcc1 \== NoPred1stOcc2, NoPred1stOcc2 > 1 -> VarName = y(_) ; true ). add_var_to_dico([_|DicoVar], Var, NoPred1stOcc, V) :- add_var_to_dico(DicoVar, Var, NoPred1stOcc, V). classif_vars([], NbY, NbY) :- !. classif_vars([v(_, _, Singleton, var(VarName, _))|DicoVar], Y, NbY) :- var(VarName), !, ( var(Singleton) -> VarName = x(void) ; VarName = x(_) ), classif_vars(DicoVar, Y, NbY). classif_vars([v(_, _, _, var(y(Y), _))|DicoVar], Y, NbY) :- Y1 is Y + 1, classif_vars(DicoVar, Y1, NbY). % Inline predicates: inline_predicate(Pred,Arity) % all predicates defined here must have a corresponding clause % gen_inline_pred/5 in pass 3 describing their associated code inline_predicate(Pred, Arity) :- g_read(inline, Inline), inline_predicate(Pred, Arity, Inline). inline_predicate('$get_cut_level', 1, _). inline_predicate('$get_current_choice', 1, _). inline_predicate('$cut', 1, _). inline_predicate('$soft_cut', 1, _). inline_predicate(=, 2, _). inline_predicate('$foreign_call_c', 1, _). inline_predicate(var, 1, t). inline_predicate(nonvar, 1, t). inline_predicate(atom, 1, t). inline_predicate(integer, 1, t). inline_predicate(float, 1, t). inline_predicate(number, 1, t). inline_predicate(atomic, 1, t). inline_predicate(compound, 1, t). inline_predicate(callable, 1, t). inline_predicate(ground, 1, t). inline_predicate(is_list, 1, t). inline_predicate(list, 1, t). inline_predicate(partial_list, 1, t). inline_predicate(list_or_partial_list, 1, t). inline_predicate(fd_var, 1, t). inline_predicate(non_fd_var, 1, t). inline_predicate(generic_var, 1, t). inline_predicate(non_generic_var, 1, t). inline_predicate(functor, 3, t). inline_predicate(arg, 3, t). inline_predicate(compare, 3, t). inline_predicate(=.., 2, t). inline_predicate(==, 2, t). inline_predicate(\==, 2, t). inline_predicate(@<, 2, t). inline_predicate(@=<, 2, t). inline_predicate(@>, 2, t). inline_predicate(@>=, 2, t). inline_predicate(is, 2, t). inline_predicate(=:=, 2, t). inline_predicate(=\=, 2, t). inline_predicate(<, 2, t). inline_predicate(=<, 2, t). inline_predicate(>, 2, t). inline_predicate(>=, 2, t). inline_predicate(g_assign, 2, t). inline_predicate(g_assignb, 2, t). inline_predicate(g_link, 2, t). inline_predicate(g_read, 2, t). inline_predicate(g_array_size, 2, t). inline_predicate(g_inc, 1, t). inline_predicate(g_inco, 2, t). inline_predicate(g_inc, 2, t). inline_predicate(g_inc, 3, t). inline_predicate(g_dec, 1, t). inline_predicate(g_deco, 2, t). inline_predicate(g_dec, 2, t). inline_predicate(g_dec, 3, t). inline_predicate(g_set_bit, 2, t). inline_predicate(g_reset_bit, 2, t). inline_predicate(g_test_set_bit, 2, t). inline_predicate(g_test_reset_bit, 2, t). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/first_arg.pl���������������������������������������������������������������0000644�0001750�0001750�00000007024�13021324543�015530� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : first_arg.pl * * Descr.: first argument detection * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ find_first_arg([], var). find_first_arg([WamInst|WamCode], FirstArg) :- ( defines_first_arg(WamInst, FirstArg) ; stopping_inst(WamInst), FirstArg = var ; find_first_arg(WamCode, FirstArg) ), !. stopping_inst(call(_)). stopping_inst(execute(_)). stopping_inst(cut(_)). stopping_inst(soft_cut(_)). stopping_inst(WamInst) :- codification(WamInst, LCode), assign_x0(LCode). assign_x0([Code|LCode]) :- ( Code = w(0) ; Code = c(R1, R2), R1 \== R2, R2 = 0 ; assign_x0(LCode) ). defines_first_arg(get_atom(A, 0), atm(A)). defines_first_arg(get_integer(N, 0), int(N)). %defines_first_arg(get_float(N,0),flt(N)). % no indexing on floats defines_first_arg(get_nil(0), atm([])). defines_first_arg(get_list(0), lst). defines_first_arg(get_structure(F / N, 0), stc(F, N)). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/syn_sugar.pl���������������������������������������������������������������0000644�0001750�0001750�00000033317�13021324543�015566� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : syn_sugar.pl * * Descr.: pass 1: syntactic sugar removing * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ syntactic_sugar_init_pred(Pred, _) :- '$aux_name'(Pred), !. syntactic_sugar_init_pred(_, _) :- g_assign(aux, 1). syntactic_sugar(SrcCl, Head, Body2) :- ( SrcCl = (Head :- Body) ; SrcCl = Head, Body = true ), !, normalize_cuts(Body, Body1), normalize_alts(Body1, Head, Body2). normalize_cuts(Body, Body2) :- g_assign(has_cut, f), get_module_of_cur_pred(Module), % to solve module qualification normalize_cuts1(Body, Module, CutVar, Body1), !, ( g_read(has_cut, t) -> Body2 = ('$get_cut_level'(CutVar), Body1) ; Body2 = Body1 ). /* About cut transparency in IF-THEN and IF-THEN-ELSE * (IF -> THEN) <==> (call(IF) -> THEN) * (IF -> THEN ; ELSE) <==> (call(IF) -> THEN ; ELSE) * * Thus the IF part is not transparent (ie. opaque) for the cut * (the cut is local to the IF) */ /* NB: difference between cut and soft cut: * * cut: a cut generates a '$get_cut_level'(V) followed by a '$cut'(V) * '$get_cut_level'(V) will give rise to a copy from X(arity) to V * (see code_gen.pl). The initialization of X(arity) is done once * at the beginning of the predicate (before any choice-point creation) * thus X(arity) is saved in choice-points. The initialization is * done by a WAM instruction get_current_choice(x(Arity)) (indexing.pl) * * soft cut: gives rise to a '$get_current_choice'(V) followed by a '$soft_cut'(V) * '$get_current_choice'(V) is translated as a WAM instruction * get_current_choice(V). * * Thus, a cut points to the last choice-point to keep while a soft cut * points to the choice-point to kill. */ normalize_cuts1(P, Module, CutVar, P1) :- var(P), normalize_cuts1(call(P), Module, CutVar, P1). normalize_cuts1((If ; R), Module, CutVar, Body) :- nonvar(If), ( If = (P -> Q), Body = ('$get_cut_level'(CutVar1), P1, '$cut'(CutVar1), Q1 ; R1) ; If = (P *-> Q), Body = ('$get_current_choice'(CutVar1), P1, '$soft_cut'(CutVar1), Q1 ; R1) ), normalize_cuts_in_if(P, P1), normalize_cuts1(Q, Module, CutVar, Q1), normalize_cuts1(R, Module, CutVar, R1). normalize_cuts1((P -> Q), Module, CutVar, Body) :- Body = ('$get_cut_level'(CutVar1), P1, '$cut'(CutVar1), Q1 ; fail), normalize_cuts_in_if(P, P1), normalize_cuts1(Q, Module, CutVar, Q1). % P *-> Q alone (i.e. not inside a ;) is logically the same as P, Q. % However a cut in the test part (P) should be local to P (as in P -> Q). % Hence we replace P *-> Q by P *-> Q1 ; fail normalize_cuts1((P *-> Q), Module, CutVar, ((P1, Q1) ; fail)) :- normalize_cuts_in_if(P, P1), normalize_cuts1(Q, Module, CutVar, Q1). normalize_cuts1(!, _, CutVar, '$cut'(CutVar)) :- g_assign(has_cut, t). normalize_cuts1((P, Q), Module, CutVar, (P1, Q1)) :- normalize_cuts1(P, Module, CutVar, P1), normalize_cuts1(Q, Module, CutVar, Q1). normalize_cuts1((P ; Q), Module, CutVar, (P1 ; Q1)) :- normalize_cuts1(P, Module, CutVar, P1), normalize_cuts1(Q, Module, CutVar, Q1). normalize_cuts1(Module:G, _, CutVar, G1) :- check_module_name_qualif(Module), normalize_cuts1(G, Module, CutVar, G1). normalize_cuts1(call(G), Module, _, '$call'(G, Module, CallerFunc, CallerArity)) :- % get_module_of_cur_pred(CallerModule), % FIXME use it when implementing CallerMFA cur_pred_without_aux(CallerFunc, CallerArity). normalize_cuts1(catch(G, C, R), Module, _, '$catch'(G, C, R, Module, CallerFunc, CallerArity)) :- % get_module_of_cur_pred(CallerModule), % FIXME use it when implementing CallerMFA cur_pred_without_aux(CallerFunc, CallerArity). normalize_cuts1(throw(B), _, _, '$throw'(B, CallerModule, CallerFunc, CallerArity)) :- get_module_of_cur_pred(CallerModule), cur_pred_without_aux(CallerFunc, CallerArity). normalize_cuts1(P, Module, CutVar, P1) :- callable(P), ( var(Module) -> normalize_cuts1(call(P), Module, CutVar, P1) ; useless_module_qualification(Module, P) -> P1 = P ; P1 = Module:P ). normalize_cuts1(P, _Module, _CutVar, _P1) :- error('body goal is not callable (~q)', [P]). /* A cut in the if-part is local (if-part is opaque) * If a cut appears we have to create an aux predicate * for this we use a '$force_aux_pred'/1 term. * If there is no if, nothing has to be done. */ normalize_cuts_in_if(P, '$force_aux_pred'(P1)) :- g_read(has_cut, SaveHasCut), g_assign(has_cut, f), normalize_cuts(P, P1), g_read(has_cut, HasCut), g_assign(has_cut, SaveHasCut), HasCut = t, !. normalize_cuts_in_if(P, P). useless_module_qualification(system, _). useless_module_qualification(user, _). useless_module_qualification(Module, _) :- get_module_of_cur_pred(Module). useless_module_qualification(Module, P) :- '$get_module_of_goal'(Module, P, system). normalize_alts(Body, Head, Body1) :- functor(Head, Pred, N), g_assign(head_functor, Pred), g_assign(head_arity, N), normalize_alts1(Body, Head, Body1), !. normalize_alts1(X, _, call(X)) :- var(X). normalize_alts1((P, Q), RestC, (P1, Q1)) :- normalize_alts1(P, (RestC, Q), P1), normalize_alts1(Q, (RestC, P), Q1). normalize_alts1(Body0, RestC, AuxPred) :- ( Body0 = (_ ; _), Body = Body0 ; Body0 = '$force_aux_pred'(Body) ), lst_var(RestC, [], VarRestC), lst_var(Body, [], VarAlt), set_inter(VarAlt, VarRestC, V), length(V, N1), g_read(head_functor, Pred), g_read(head_arity, N), init_aux_pred_name(Pred, N, AuxName, N1), AuxPred =.. [AuxName|V], g_read(where, Where), linearize(Body, AuxPred, Where, LAuxSrcCl), asserta(buff_aux_pred(AuxName, N1, LAuxSrcCl)). normalize_alts1(P, _, P2) :- meta_pred_rewriting(P, P1), pred_rewriting(P1, P2), !. init_aux_pred_name(Pred, N, AuxName, N1) :- g_read(aux, Aux), Aux1 is Aux + 1, g_assign(aux, Aux1), '$make_aux_name'(Pred, N, Aux, AuxName), ( test_pred_info(bpl, Pred, N), set_pred_info(bpl, AuxName, N1) ; test_pred_info(bfd, Pred, N), set_pred_info(bfd, AuxName, N1) ; true ), !. linearize(Body, AuxPred, Where, LAuxSrcCl) :- ( Body = (P ; Q) -> linearize(Q, AuxPred, Where, LAuxSrcCl1), linearize1(P, AuxPred, Where, LAuxSrcCl2), append(LAuxSrcCl2, LAuxSrcCl1, LAuxSrcCl) ; linearize1(Body, AuxPred, Where, LAuxSrcCl) ). linearize1(fail, _, _, []) :- !. linearize1(P, AuxPred, Where, [Where + AltP]) :- copy_term((AuxPred :- P), AltP). lst_var(X, V, V1) :- var(X), !, set_add(V, X, V1). lst_var(P, V, V1) :- functor(P, _, N), lst_var_args(1, N, P, V, V1). lst_var_args(I, N, P, V, V2) :- ( I =< N -> arg(I, P, ArgP), lst_var(ArgP, V, V1), I1 is I + 1, lst_var_args(I1, N, P, V1, V2) ; V2 = V ). % Other predicate rewriting pred_rewriting(fd_tell(X), T) :- % FD transformation test_c_call_allowed(fd_tell / 1), pred_rewriting('$call_c'(X, [boolean]), T). pred_rewriting(set_bip_name(Name, Arity), Pred1) :- g_read(inline, t), % also if byte code since implies --no-inline ( atom(Name), integer(Arity) -> CallC = '$call_c'('Pl_Set_Bip_Name_Untagged_2'(Name, Arity), [by_value]) ; CallC = '$call_c'('Pl_Set_Bip_Name_2'(Name, Arity)) ), pred_rewriting(CallC, Pred1). pred_rewriting(Pred, Pred1) :- % math define current bip g_read(inline, t), % also if byte code since implies --no-inline g_read(fast_math, f), functor(Pred, F, 2), ( F = (is) ; math_cmp_functor_name(F, _) ), % see code_gen.pl pred_rewriting(set_bip_name(F, 2), T), Pred1 = (T, Pred). pred_rewriting(term_hash(Term, Hash), Pred1) :- g_read(inline, t), % also if byte code since implies --no-inline catch(term_hash(Term, Hash1), _, fail), % if there is an error, do not inline ! integer(Hash1), !, pred_rewriting(set_bip_name(term_hash, 2), T), pred_rewriting('$call_c'('Pl_Un_Integer_Check'(Hash1, Hash), [boolean]), T2), Pred1 = (T, T2). pred_rewriting(term_hash(Term, Depth, Range, Hash), Pred1) :- g_read(inline, t), % also if byte code since implies --no-inline catch(term_hash(Term, Depth, Range, Hash1), _, fail), % if there is an error, do not inline ! integer(Hash1), !, pred_rewriting(set_bip_name(term_hash, 4), T), pred_rewriting('$call_c'('Pl_Un_Integer_Check'(Hash1, Hash), [boolean, by_value]), T2), Pred1 = (T, T2). % The user should use: '$call_c'(F) or '$call_c'(F, LCOpt) % LCOpt is a list containing: % jump/boolean % fast_call (use a fact call convention) % tagged (use tagged calls for atom, integers and F/N) % by_value (pass atom, numbers, F/N by value not by WamWord) % use_x_regs (the function can destroy any X register) % % Backward compatibility: '$call_c_test'/1 and '$call_c_jump'/1 are % kept for the moment... % do not use LCOpt1 = '$no_internal_transf$'(LCOpt) for bootstrapping pred_rewriting('$call_c'(F, LCOpt), '$call_c'(F, LCOpt1)) :- test_c_call_allowed('$call_c' / 2), no_internal_transf(LCOpt, LCOpt1). pred_rewriting('$call_c'(F), T) :- test_c_call_allowed('$call_c' / 1), pred_rewriting('$call_c'(F, []), T). % backward compatibility pred_rewriting('$call_c_test'(F), T) :- test_c_call_allowed('$call_c_test' / 1), pred_rewriting('$call_c'(F, [boolean]), T). % backward compatibility pred_rewriting('$call_c_jump'(F), T) :- test_c_call_allowed('$call_c_jump' / 1), pred_rewriting('$call_c'(F, [jump]), T). pred_rewriting(P, P). test_c_call_allowed(_) :- g_read(call_c, t), !. test_c_call_allowed(X) :- error('~q not allowed in this mode', [X]). % can be considered as inline (neither CP nor X regs to save) not_dangerous_c_call([]). not_dangerous_c_call([COpt|LCOpt]) :- COpt \== jump, COpt \== use_x_regs, not_dangerous_c_call(LCOpt). add_wrapper_to_dyn_clause(Pred, N, Where + Cl, AuxName) :- init_aux_pred_name(Pred, N, AuxName, N), ( Cl = (Head :- Body) -> head_wrapper(Head, AuxName, Head1), Cl1 = (Head1 :- Body) ; head_wrapper(Cl, AuxName, Cl1) ), assertz(buff_aux_pred(AuxName, N, [Where + Cl1])). head_wrapper(Head, AuxName, Head1) :- Head =.. [_|LArgs], Head1 =.. [AuxName|LArgs]. % meta_predicate rewriting meta_pred_rewriting(P1, P2) :- % nonvar(P1), % useless functor(P1, Pred, N), get_meta_pred_decl(Pred, N, MetaDecl), !, functor(P2, Pred, N), meta_pred_rewrite_args(1, N, P1, MetaDecl, P2). meta_pred_rewriting(P, P). get_meta_pred_decl(Pred, N, MetaDecl) :- clause(meta_pred(Pred, N, MetaDecl), _), !. get_meta_pred_decl(Pred, N, MetaDecl) :- '$predicate_property1'(Pred, N, built_in), '$predicate_property1'(Pred, N, meta_predicate(MetaDecl)), !. meta_pred_rewrite_args(I, N, P1, MetaDecl, P2) :- I =< N, !, arg(I, P1, A1), arg(I, P2, A2), arg(I, MetaDecl, Spec), meta_pred_rewrite_arg(Spec, A1, A2), I1 is I + 1, meta_pred_rewrite_args(I1, N, P1, MetaDecl, P2). meta_pred_rewrite_args(_, _, _, _, _). meta_pred_rewrite_arg(Spec, A, A) :- var(Spec), !. meta_pred_rewrite_arg(:, A1, A2) :- !, meta_pred_rewrite_arg(0, A1, A2). meta_pred_rewrite_arg(Spec, A1, '$mt'(Module, A1)) :- integer(Spec), % functor(A1, F, N), (F \== '$mt' ; N \== 2), !, % do not nest meta_term args get_module_of_cur_pred(Module). meta_pred_rewrite_arg(_, A, A). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/OTHER_PL�������������������������������������������������������������������0000644�0001750�0001750�00000002212�13021324543�014404� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� Compiling pl2wam with various Prolog Systems -------------------------------------------- Go to the src/Pl2Wam sub-directory. The idea is to compile the file whole.pl (which produces a file whole.wam). GNU-Prolog ---------- Then get the user time give by time time pl2wam whole.pl YAP Prolog ---------- under yap ?- compile([compat,whole,yaplib]). ?- statistics(runtime, _), pl2wam([whole]), statistics(runtime,[_,T]). SICStus Prolog -------------- under sicstus | ?- compile([compat,whole,sicslib]). when asked for predicate redefinitions: type 'p' (redefine all). To obtain a bench: | ?- statistics(runtime, _), pl2wam([whole]), statistics(runtime,[_,T]). CIAO Prolog ----------- I have a problem with the modules of CIAO Prolog. Here is a solution: Create a file x.pl as follows: cat compat.pl whole.pl ciaolib.pl >x.pl echo 'b(T):- statistics(runtime, _), pl2wam([whole]), statistics(runtime,[_,T]). ' >>x.pl under ciao: ?- compile(x). To obtain a bench: ?- b(T). SWI-Prolog ---------- under pl: ?- [compat,whole,swilib]. To obtain a bench: ?- T0 is cputime, pl2wam([whole]), T is cputime-T0. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/wam_emit.pl����������������������������������������������������������������0000644�0001750�0001750�00000034071�13021324543�015354� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : wam_emit.pl * * Descr.: code emission * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * WAM Instructions * * * * get_variable(V, A) put_variable(V, A) * * put_void(A) * * get_value(V, A) put_value(V, A) * * put_unsafe_value(y(Y), A) * * get_atom(F, A) put_atom(F, A) * * get_integer(N, A) put_integer(N, A) * * get_float(D, A) put_float(D, A) * * get_nil(A) put_nil(A) * * get_list(A) put_list(A) * * get_structure(F/N, A) put_structure(F/N, A) * * put_meta_term(M, X, A) * * * * math_load_value(V, A) * * math_fast_load_value(V, A) * * * * unify_variable(V) allocate(N) * * unify_void(N) deallocate * * unify_value(V) * * unify_local_value(V) call(F/N) * * unify_atom(F) execute(F/N) * * unify_integer(N) proceed * * unify_nil fail * * unify_list (only for the last subterm if it is a list) * * unify_structure(F/N) (only for the last subterm if it is a structure) * * * * label(L) * * * * switch_on_term(Lvar, Latm, Lint, Llst, Lstc) * * switch_on_atom([(F,L),...]) * * switch_on_integer([(N,L),...]) * * switch_on_structure([(F/N,L),...]) * * * * try_me_else(L) try(L) * * retry_me_else(L) retry(L) * * trust_me_else_fail trust(L) * * * * get_current_choice(V) pragma_arity(N) (for cut) * * cut(V) * * soft_cut(V) * * * * call_c(F, [T,...], [W,...]) * * F=FctName, T=option only these options are relevant: * * - jump/boolean/x(X) (jump at / test / move returned value) * * - set_cp (set CP before the call at the next instruction) * * - fast_call (use a fact call convention) * * - tagged (use tagged calls for atoms, integers and F/N) * * * * foreign_call_c(F, T0, P/N, K, [(M1, T1),...]) * * F=FctName, T0=Return, P/N=BipName/BipArity, K=ChcSize * * Mi=mode (in/out/in_out), Ti=type * * * * V : x(X) or y(Y) * * X, Y : integer >= 0 * * A : integer * * D : float * * N, K : integer * * F, T, M: atom * * W : atom or integer or float or atom/integer or x(X) * * L : integer >= 1 (with no "holes") or 'fail' inside switch_on_term * *-------------------------------------------------------------------------*/ emit_code_init(WamFile0, PlFile0) :- prolog_file_name(PlFile0, PlFile), emit_code_files(WamFile0, PlFile, WamFile), ( WamFile = user -> current_output(Stream) ; open(WamFile, write, Stream) ), g_assign(streamwamfile, Stream), g_assign(cur_pl_file, ''), prolog_name(Name), prolog_version(Version), format(Stream, '%% compiler: ~a ~a~n', [Name, Version]), format(Stream, '%% file : ~a~n', [PlFile]), g_read(wam_comment, Cmt), ( Cmt = '' -> true ; format(Stream, '%% ~a~n', [Cmt]) ). emit_code_files('', user, user) :- !. emit_code_files('', PlFile, WamFile) :- !, decompose_file_name(PlFile, _, Prefix, Suffix), ( g_read(native_code, t) -> WamSuffix = '.wam' ; WamSuffix = '.wbc' ), ( '$prolog_file_suffix'(Suffix) -> atom_concat(Prefix, WamSuffix, WamFile) ; atom_concat(Prefix, Suffix, WF), atom_concat(WF, WamSuffix, WamFile) ). emit_code_files(WamFile, _, WamFile). /* :- if(\+ '$current_predicate_any'('$prolog_file_suffix'/1)). '$prolog_file_suffix'('.pl'). '$prolog_file_suffix'('.pro'). '$prolog_file_suffix'('.prolog'). :- endif. */ emit_code_term(Bytes, Lines) :- g_read(streamwamfile, Stream), character_count(Stream, Bytes), line_count(Stream, Lines), close(Stream). emit_code(Pred, N, PlFile, PlLine, WamCode) :- g_read(streamwamfile, Stream), emit_pred_start(Pred, N, PlFile, PlLine, Stream, _), emit_wam_code(WamCode, _, Stream), write(Stream, ']).'), nl(Stream). emit_pred_start(Pred, 0, PlFile, PlLine, Stream, Type) :- ( Pred = '$exe_user', Type = user ; Pred = '$exe_system', Type = system ), !, emit_file_name_if_needed(PlFile, Stream), format(Stream, '~n~ndirective(~d,~a,', [PlLine, Type]). emit_pred_start(Pred, N, PlFile, PlLine, Stream, _) :- emit_file_name_if_needed(PlFile, Stream), ( test_pred_info(dyn, Pred, N) -> StaDyn = (dynamic) ; StaDyn = (static) ), ( test_pred_info(pub, Pred, N) -> PubPriv = (public) ; PubPriv = (private) ), ( test_pred_info(multi, Pred, N) -> MonoMulti = (multifile) ; MonoMulti = (monofile) ), get_module_of_pred(Pred, N, Module), export_type(Pred, N, ExportBplBfd), format(Stream, '~n~npredicate(~q,~d,~a,~a,~a,~a,', [Module:Pred/N, PlLine, StaDyn, PubPriv, MonoMulti, ExportBplBfd]). export_type(Pred, _, local) :- '$aux_name'(Pred), !. export_type(Pred, N, local) :- test_pred_info(multi, Pred, N), !. export_type(Pred, N, built_in) :- test_pred_info(bpl, Pred, N), !. export_type(Pred, N, built_in_fd) :- test_pred_info(bfd, Pred, N), !. export_type(_, _, global) :- % global means now exported g_read(module_already_seen, f), !. export_type(Pred, N, global) :- is_exported(Pred, N), !. export_type(_, _, local). emit_file_name_if_needed(PlFile, _) :- g_read(cur_pl_file, PlFile), !. emit_file_name_if_needed(PlFile, Stream) :- format(Stream, '~n~nfile_name(~q).~n', [PlFile]), g_assign(cur_pl_file, PlFile). emit_wam_code([], _, _). emit_wam_code([WamInst|WamCode], First, Stream) :- emit_wam_code(WamInst, First, Stream), % for nested code emit_wam_code(WamCode, First, Stream), !. emit_wam_code(WamInst, First, Stream) :- special_form(WamInst, WamInst1), emit_wam_code(WamInst1, First, Stream). emit_wam_code(WamInst, _, _) :- g_read(keep_void_inst, KeepVoidInst), dummy_instruction(WamInst, KeepVoidInst), !. emit_wam_code(WamInst, First, Stream) :- WamInst = label(_), !, ( var(First) -> Car = '[', First = f ; Car = (',') ), format(Stream, '~a~n~n', [Car]), emit_one_inst(WamInst, Stream). emit_wam_code(WamInst, First, Stream) :- ( var(First) -> Car = '[', First = f ; Car = (',') ), format(Stream, '~a~n ', [Car]), emit_one_inst(WamInst, Stream). emit_one_inst(WamInst, Stream) :- atom(WamInst), !, writeq(Stream, WamInst). emit_one_inst(WamInst, Stream) :- functor(WamInst, F, N), writeq(Stream, F), emit_args(0, N, WamInst, Stream), write(Stream, ')'). emit_args(N, N, _, _) :- !. emit_args(I, N, WamInst, Stream) :- I1 is I + 1, ( I1 = 1 -> put_char(Stream, '(') ; put_char(Stream, ',') ), arg(I1, WamInst, A), emit_one_arg(A, Stream), emit_args(I1, N, WamInst, Stream). emit_one_arg([X|L], Stream) :- length(L, N), % split long lists N > 30, !, put_char(Stream, '['), line_position(Stream, P), write_term(Stream, X, [quoted(true), priority(999)]), emit_list(L, P, Stream). emit_one_arg(A, Stream) :- g_read(native_code, f), % if also wanted for .wam remove this line emit_one_f_n(A, Stream), !. % if fail breakthrough emit_one_arg(A, Stream) :- writeq(Stream, A). /* this is added to fix a bug with consult/1. Pb with operators: * :- op(500, xfx, edge). * p(a edge b). * :- op(0, xfx, edge). * will fail if edge is declared in the top-level before consult */ emit_one_f_n(M:P/N, Stream) :- format(Stream, '(~q):(~q)/~q', [M, P, N]). emit_one_f_n(F/N, Stream) :- format(Stream, '(~q)/~q', [F, N]). emit_list([], _, Stream) :- put_char(Stream, ']'). emit_list([X|L], P, Stream) :- format(Stream, ',~n~*c', [P, 32]), % changed 0' to 32 for emacs highlighting write_term(Stream, X, [quoted(true), priority(999)]), emit_list(L, P, Stream). emit_ensure_linked :- g_read(streamwamfile, Stream), retract(ensure_linked(Name, Arity)), !, format(Stream, '~n~nensure_linked([~q', [Name / Arity]), ( clause(ensure_linked(Name1, Arity1), _), format(Stream, ',~q', [Name1 / Arity1]), fail ; true ), write(Stream, ']).'), nl(Stream). emit_ensure_linked. bc_emit_code(Pred, N, PlFile, PlLine, LCompCl) :- g_read(streamwamfile, Stream), emit_pred_start(Pred, N, PlFile, PlLine, Stream, Type), ( nonvar(Type) -> LCompCl = [bc((_ :- Body), _)], bc_emit_prolog_term(Stream, Body), format(Stream, ').~n', []) ; length(LCompCl, NbCl), ( LCompCl = [bc('$$empty$$predicate$$clause$$', [proceed])] -> NbCl1 = 0, LCompCl1 = [] ; NbCl1 = NbCl, LCompCl1 = LCompCl ), format(Stream, '~d).~n', [NbCl1]), bc_emit_lst_clause(LCompCl1, Stream) ). bc_emit_lst_clause([], _). bc_emit_lst_clause([bc(Cl, WamCode)|LCompCl], Stream) :- format(Stream, '~n~nclause(', []), bc_emit_prolog_term(Stream, Cl), write(Stream, ','), emit_wam_code(WamCode, _, Stream), format(Stream, ']).~n', []), bc_emit_lst_clause(LCompCl, Stream). bc_emit_prolog_term(Stream, Term) :- % create choice point for '$above'/1 write option '$get_current_B'(B), name_singleton_vars(Term), bind_variables(Term, [exclude([Term])]), write_term(Stream, Term, [numbervars(true), namevars(true), '$above'(B), ignore_ops(true), quoted(true)]), fail. bc_emit_prolog_term(_, _). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/code_gen.pl����������������������������������������������������������������0000644�0001750�0001750�00000064201�13021324543�015313� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog to WAM compiler * * File : code_gen.pl * * Descr.: pass 3: code generation * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ code_generation(Head, Body, NbChunk, NbY, WamHead) :- g_assign(last_pred, f), g_assign(treat_body, f), generate_head(Head, NbChunk, NbY, WamBody, WamHead), g_assign(treat_body, t), generate_body(Body, NbChunk, WamBody). generate_head(p(_, _, _ / N, LArg), NbChunk, NbY, WamNext, WamHead) :- gen_list_integers(0, N, LReg), ( g_read(reorder, t) -> reorder_head_arg_lst(LArg, LReg, LArg1, LReg1) ; LArg1 = LArg, LReg1 = LReg ), gen_unif_arg_lst(LArg1, LReg1, WamNext, WamLArg), ( NbChunk > 1 -> WamHead = [allocate(NbY)|WamLArg] ; WamHead = WamLArg ). reorder_head_arg_lst(LArg, LReg, LArg1, LReg1) :- split_arg_lst(LArg, LReg, LArgK, LRegK, LArgS, LRegS, LArgT, LRegT), reverse(LArgT, LArgT1), reverse(LRegT, LRegT1), append(LArgK, LArgT1, LArgKT), append(LArgKT, LArgS, LArg1), append(LRegK, LRegT1, LRegKT), append(LRegKT, LRegS, LReg1). generate_body([], _, [proceed]). generate_body([p(NoPred, Module, Pred / N, LArg)|Body], NbChunk, WamPred) :- ( NoPred = NbChunk -> g_assign(last_pred, t) ; true ), generate_body1(Pred, N, Module, LArg, NoPred, Body, NbChunk, WamPred). generate_body1(fail, 0, _, _, _, _, _, [fail]) :- !. generate_body1('$call_c', 2, _, [Arg, LCOpt], NoPred, Body, NbChunk, WamArgs) :- !, ( Arg = atm(Name), LStcArg = [] ; Arg = stc(Name, _, LStcArg) ), ( Body \== [], memberchk(jump, LCOpt) -> LCOpt1 = [set_cp|LCOpt] ; LCOpt1 = LCOpt ), load_c_call_args(LCOpt, LStcArg, LValue, WamCallC1, WamArgs), WamCallCInst = call_c(Name, LCOpt1, LValue), ( Body = [] -> ( NoPred > 1 -> WamCallC1 = [deallocate, WamCallCInst, proceed] ; WamCallC1 = [WamCallCInst, proceed] ) ; WamCallC1 = [WamCallCInst|WamBody], generate_body(Body, NbChunk, WamBody) ). generate_body1(Pred, N, _, LArg, NoPred, Body, NbChunk, WamPred) :- inline_predicate(Pred, N), !, gen_inline_pred(Pred, N, LArg, WamBody, WamPred), !, ( Body = [] -> ( NoPred > 1 -> WamBody = [deallocate, proceed] ; WamBody = [proceed] ) ; generate_body(Body, NbChunk, WamBody) ). generate_body1(Pred, N, Module, LArg, NoPred, Body, NbChunk, WamLArg) :- gen_list_integers(0, N, LReg), ( g_read(reorder, t) -> reorder_body_arg_lst(LArg, LReg, LArg1, LReg1) ; LArg1 = LArg, LReg1 = LReg ), gen_load_arg_lst(LArg1, LReg1, WamCallExecute, WamLArg), qualif_with_module(Module, Pred, N, MPredN), ( Body = [] -> ( NoPred > 1 -> WamCallExecute = [deallocate, execute(MPredN)] ; WamCallExecute = [execute(MPredN)] ) ; WamCallExecute = [call(MPredN)|WamBody], generate_body(Body, NbChunk, WamBody) ). qualif_with_module(Module, Pred, N, Module:Pred/N) :- nonvar(Module), Module \== system, Module \== user, !. qualif_with_module(_, Pred, N, Pred/N). reorder_body_arg_lst(LArg, LReg, LArg1, LReg1) :- split_arg_lst(LArg, LReg, LArgK, LRegK, LArgS, LRegS, LArgT, LRegT), append(LArgS, LArgT, LArgST), append(LArgST, LArgK, LArg1), append(LRegS, LRegT, LRegST), append(LRegST, LRegK, LReg1). % split LArg/LReg in: % LArgK/LRegK: known elements (without temporaries) % LArgS/LRegS: structures containing temporaries % LArgT/LRegT: temporaries split_arg_lst([], [], [], [], [], [], [], []). split_arg_lst([Arg|LArg], [Reg|LReg], LArgK, LRegK, LArgS, LRegS, LArgT, LRegT) :- ( Arg = var(x(No), _), No \== void, LArgK = LArgK1, LRegK = LRegK1, LArgS = LArgS1, LRegS = LRegS1, LArgT = [Arg|LArgT1], LRegT = [Reg|LRegT1] ; Arg = stc(_, _, LStcArg), has_temporaries(LStcArg), LArgK = LArgK1, LRegK = LRegK1, LArgS = [Arg|LArgS1], LRegS = [Reg|LRegS1], LArgT = LArgT1, LRegT = LRegT1 ; LArgK = [Arg|LArgK1], LRegK = [Reg|LRegK1], LArgS = LArgS1, LRegS = LRegS1, LArgT = LArgT1, LRegT = LRegT1 ), !, split_arg_lst(LArg, LReg, LArgK1, LRegK1, LArgS1, LRegS1, LArgT1, LRegT1). has_temporaries([Arg|LArg]) :- ( Arg = var(x(No), _), No \== void ; Arg = stc(_, _, LStcArg), has_temporaries(LStcArg) ; has_temporaries(LArg) ), !. % gen_unif_arg_lst(LArg, LReg, WamNext, WamLArg) gen_unif_arg_lst([], [], WamNext, WamNext). gen_unif_arg_lst([Arg|LArg], [Reg|LReg], WamNext, WamArg) :- gen_unif_arg(Arg, Reg, WamLArg, WamArg), gen_unif_arg_lst(LArg, LReg, WamNext, WamLArg). % gen_unif_arg(Arg, Reg, WamNext, WamArg) gen_unif_arg(var(VarName, Info), Reg, WamNext, WamArg) :- ( var(Info) -> ( VarName == x(void) -> WamArg = WamNext ; ( g_read(treat_body, t), VarName = y(_) -> Info = unsafe % p :- A=B, dummy, A=1, q(B). needs a put_unsafe_value for B (y(1)) ; Info = not_in_cur_env ), WamArg = [get_variable(VarName, Reg)|WamNext] ) ; WamArg = [get_value(VarName, Reg)|WamNext] ). gen_unif_arg(atm(A), Reg, WamNext, [get_atom(A, Reg)|WamNext]). gen_unif_arg(int(N), Reg, WamNext, [get_integer(N, Reg)|WamNext]). gen_unif_arg(flt(N), Reg, WamNext, [get_float(N, Reg)|WamNext]). gen_unif_arg(nil, Reg, WamNext, [get_nil(Reg)|WamNext]). gen_unif_arg(stc(F, N, LStcArg), Reg, WamNext, [WamInst|WamStcArg]) :- ( F = '.', N = 2 -> WamInst = get_list(Reg) ; WamInst = get_structure(F / N, Reg) ), flat_stc_arg_lst(LStcArg, head, LStcArg1, LArgAux, LRegAux), gen_subterm_arg_lst(LStcArg1, WamArgAux, WamStcArg), gen_unif_arg_lst(LArgAux, LRegAux, WamNext, WamArgAux). % gen_load_arg_lst(LArg, LReg, WamNext, WamLArg) gen_load_arg_lst([], [], WamNext, WamNext). gen_load_arg_lst([Arg|LArg], [Reg|LReg], WamNext, WamArg) :- gen_load_arg(Arg, Reg, WamLArg, WamArg), gen_load_arg_lst(LArg, LReg, WamNext, WamLArg). % gen_load_arg(Arg, Reg, WamNext, WamArg) gen_load_arg(var(VarName, Info), Reg, WamNext, WamCode) :- ( var(Info) -> ( VarName == x(void) -> WamInst = put_void(Reg) ; ( VarName = x(_) -> Info = in_heap ; Info = unsafe, ( g_read(last_pred, t) -> % can occur for false y var by optim: p :- _=B, dummy, r(B). WamInstBis = put_unsafe_value(VarName, Reg) ; true ) ), WamInst = put_variable(VarName, Reg) ) ; Info = unsafe, g_read(last_pred, t) -> WamInst = put_unsafe_value(VarName, Reg) ; WamInst = put_value(VarName, Reg) ), ( var(WamInstBis) -> WamCode = [WamInst|WamNext] ; WamCode = [WamInst, WamInstBis|WamNext] ). gen_load_arg(atm(A), Reg, WamNext, [put_atom(A, Reg)|WamNext]). gen_load_arg(int(N), Reg, WamNext, [put_integer(N, Reg)|WamNext]). gen_load_arg(flt(N), Reg, WamNext, [put_float(N, Reg)|WamNext]). gen_load_arg(nil, Reg, WamNext, [put_nil(Reg)|WamNext]). gen_load_arg(stc('$mt', 2, [atm(Module), Goal]), Reg, WamNext, WamInst) :- !, gen_load_arg(Goal, Reg1, WamMT, WamInst), WamMT = [put_meta_term(Module, Reg1, Reg)|WamNext]. gen_load_arg(stc(F, N, LStcArg), Reg, WamNext, WamArgAux) :- ( F = '.', N = 2 -> WamInst = put_list(Reg) ; WamInst = put_structure(F / N, Reg) ), flat_stc_arg_lst(LStcArg, body, LStcArg1, LArgAux, LRegAux), gen_load_arg_lst(LArgAux, LRegAux, [WamInst|WamStcArg], WamArgAux), gen_subterm_arg_lst(LStcArg1, WamNext, WamStcArg). % flat_stc_arg_lst(LStcArg, HB, LStcArg1, LArgAux, LRegAux) flat_stc_arg_lst([], _, [], [], []). flat_stc_arg_lst([StcArg|LStcArg], HB, [StcArg|LStcArg1], LArgAux, LRegAux) :- simple_stc_arg(StcArg), !, flat_stc_arg_lst(LStcArg, HB, LStcArg1, LArgAux, LRegAux). flat_stc_arg_lst([StcArg], HB, [stc(F, N, LStcArg1)], LArgAux, LRegAux) :- g_read(opt_last_subterm, t), % last subterm unif stc optimization StcArg = stc(F, N, LStcArg), ( F \== '$mt' ; N \== 2 ), !, flat_stc_arg_lst(LStcArg, HB, LStcArg1, LArgAux, LRegAux). flat_stc_arg_lst([StcArg|LStcArg], HB, [V|LStcArg1], [StcArg|LArgAux], [X|LRegAux]) :- ( HB = head -> V = var(x(X), _) ; V = var(x(X), in_heap) ), flat_stc_arg_lst(LStcArg, HB, LStcArg1, LArgAux, LRegAux). simple_stc_arg(var(_, _)). simple_stc_arg(atm(_)). simple_stc_arg(int(_)). simple_stc_arg(nil). % gen_subterm_arg_lst(LStcArg, WamNext, WamLStcArg) gen_subterm_arg_lst([], WamNext, WamNext). gen_subterm_arg_lst([Arg|LArg], WamNext, WamArg) :- gen_compte_void([Arg|LArg], 0, N, LArg1), ( N = 0 -> gen_subterm_arg(Arg, WamLArg, WamArg), gen_subterm_arg_lst(LArg, WamNext, WamLArg) ; WamArg = [unify_void(N)|WamLArg1], gen_subterm_arg_lst(LArg1, WamNext, WamLArg1) ). gen_compte_void([var(x(No), _)|LArg], N, N2, LArg1) :- No == void, !, N1 is N + 1, gen_compte_void(LArg, N1, N2, LArg1). gen_compte_void(LArg, N, N, LArg). gen_subterm_arg(var(VarName, Info), WamNext, [WamInst|WamNext]) :- ( var(Info) -> Info = in_heap, WamInst = unify_variable(VarName) ; Info = in_heap -> WamInst = unify_value(VarName) ; WamInst = unify_local_value(VarName) ). gen_subterm_arg(atm(A), WamNext, [unify_atom(A)|WamNext]). gen_subterm_arg(int(N), WamNext, [unify_integer(N)|WamNext]). gen_subterm_arg(nil, WamNext, [unify_nil|WamNext]). gen_subterm_arg(stc(F, N, LStcArg), WamNext, [WamInst|WamLStcArg]) :- ( F = '.', N = 2 -> WamInst = unify_list ; WamInst = unify_structure(F / N) ), gen_subterm_arg_lst(LStcArg, WamNext, WamLStcArg). gen_list_integers(I, N, L) :- ( I < N -> L = [I|L1], I1 is I + 1, gen_list_integers(I1, N, L1) ; L = [] ). % called at code emission special_form(put_variable(x(X), X), put_void(X)). dummy_instruction(get_variable(x(X), X), f). dummy_instruction(put_value(x(X), X), f). % Inline predicate code generation: % gen_inline_pred(Pred, Arity, LArg, WamNext, WamPred) % % the predicates defined here must have a corresponding clause % inline_predicate/2 (in pass 2). :- discontiguous(gen_inline_pred / 5). % Cut inline ('$get_cut_level'/1, '$get_current_choice'/1, '$cut'/1, '$soft_cut'/1) gen_inline_pred('$get_cut_level', 1, [Arg], WamNext, WamArg) :- cur_pred(Pred, N), set_pred_info(cut, Pred, N), gen_unif_arg(Arg, N, WamNext, WamArg). gen_inline_pred('$get_current_choice', 1, [var(VarName, _)], WamNext, [WamInst|WamNext]) :- WamInst = get_current_choice(VarName). gen_inline_pred('$cut', 1, [var(VarName, _)], WamNext, [WamInst|WamNext]) :- WamInst = cut(VarName). gen_inline_pred('$soft_cut', 1, [var(VarName, _)], WamNext, [WamInst|WamNext]) :- WamInst = soft_cut(VarName). % Unification inline (=/2) gen_inline_pred(=, 2, [Arg1, Arg2], WamNext, WamEqual) :- equal(Arg1, Arg2, WamNext, WamEqual), !. equal(Arg1, Arg2, WamNext, WamNext) :- Arg1 == Arg2. equal(var(x(Reg), Info), _, WamNext, WamNext) :- var(Info), % is this test useful ? i do not think so. void ==> var(Info) ? Reg == void. equal(_, var(x(Reg), Info), WamNext, WamNext) :- var(Info), % is this test useful ? i do not think so Reg == void. equal(var(VarName, Info), var(VarName, Info), WamNext, WamNext) :- var(Info). equal(V1, Arg2, WamNext, WamEqual) :- V1 = var(VarName1, Info1), ( VarName1 = x(Reg1) -> ( Reg1 == void -> WamNext = WamEqual ; inline_unif_reg_term(Info1, Reg1, Arg2, WamNext, WamEqual) ) ; gen_load_arg(V1, IReg, WamEqual1, WamEqual), gen_unif_arg(Arg2, IReg, WamNext, WamEqual1) ). equal(Arg1, V2, WamNext, WamEqual) :- V2 = var(VarName2, Info2), ( VarName2 = x(Reg2) -> ( Reg2 == void -> WamNext = WamEqual ; inline_unif_reg_term(Info2, Reg2, Arg1, WamNext, WamEqual) ) ; gen_load_arg(V2, IReg, WamEqual1, WamEqual), gen_unif_arg(Arg1, IReg, WamNext, WamEqual1) ). equal(Arg1, var(x(Reg2), Info2), WamNext, WamEqual) :- inline_unif_reg_term(Info2, Reg2, Arg1, WamNext, WamEqual). equal(stc(F, N, LStcArg1), stc(F, N, LStcArg2), WamNext, WamEqual) :- equal_lst(LStcArg1, LStcArg2, WamNext, WamEqual). equal(_, _, WamNext, [fail|WamNext]) :- warn('explicit unification will fail', []). equal_lst([], [], WamNext, WamNext). equal_lst([Arg1|LArg1], [Arg2|LArg2], WamNext, WamEqual) :- equal(Arg1, Arg2, WamLArg, WamEqual), equal_lst(LArg1, LArg2, WamNext, WamLArg). inline_unif_reg_term(Info, Reg, Arg, WamNext, WamUnif) :- ( var(Info) -> gen_load_arg(Arg, Reg, WamNext, WamUnif1), ( var(Info) -> % if Info=in_heap then Reg appeared in Arg thus we have an occurs check Info = in_heap, % like in p :- A = f(A), write(A). WamUnif = WamUnif1 ; warn('explicit unification will fail due to cyclic term (occurs check)', []), WamUnif = [fail|WamNext] ) ; gen_unif_arg(Arg, Reg, WamNext, WamUnif) ). % Mathematical inlines (is/2, =:=/2, ...) /* provisional... pb with allocator to reuse VN2 for VN1 gen_inline_pred(is, 2, [var(VN1, Info1), stc(+, 2, [var(VN2, Info2), int(1)])], WamNext, WamMath) :- var(Info1), !, ( var(Info2) -> error('unbound variable in arithmetic expression', []) ; true ), Info1 = not_in_cur_env, WamMath = [call_c('Math_X_is_inc_y',[fast],[&,VN1,VN2])|WamNext]. */ gen_inline_pred(is, 2, [Arg1, Arg2], WamNext, WamMath) :- load_math_expr(Arg2, Reg, WamUnif, WamMath), !, gen_unif_arg(Arg1, Reg, WamNext, WamUnif). load_math_expr(var(VarName, Info), Reg, WamNext, WamMath) :- ( var(Info) -> error('unbound variable in arithmetic expression', []) ; true ), ( g_read(fast_math, t) -> WamMath = [math_fast_load_value(VarName, Reg)|WamNext] ; WamMath = [math_load_value(VarName, Reg)|WamNext] ). load_math_expr(int(N), Reg, WamNext, WamMath) :- gen_load_arg(int(N), Reg, WamNext, WamMath). load_math_expr(flt(N), Reg, WamNext, WamMath) :- gen_load_arg(flt(N), Reg, WamNext, WamMath). load_math_expr(stc(F, N, LArg), Reg, WamNext, WamMath) :- load_math_expr1(F, N, LArg, Reg, WamNext, WamMath). load_math_expr(atm(F), Reg, WamNext, WamMath) :- load_math_expr1(F, 0, [], Reg, WamNext, WamMath). load_math_expr(X, _, _, _) :- error('unknown expression in arithmetic expression (~q)', [X]). load_math_expr1('.', 2, [Arg, nil], Reg, WamNext, WamMath) :- load_math_expr(Arg, Reg, WamNext, WamMath). load_math_expr1(+, 1, [Arg], Reg, WamNext, WamMath) :- load_math_expr(Arg, Reg, WamNext, WamMath). load_math_expr1(+, 2, [Arg1, int(1)], Reg, WamNext, WamMath) :- load_math_expr1(inc, 1, [Arg1], Reg, WamNext, WamMath). load_math_expr1(-, 2, [Arg1, int(1)], Reg, WamNext, WamMath) :- load_math_expr1(dec, 1, [Arg1], Reg, WamNext, WamMath). load_math_expr1(F, N, LArg, Reg, WamNext, WamMath) :- ( g_read(fast_math, t) -> fast_exp_functor_name(F, N, Name) ; math_exp_functor_name(F, N, Name) ), load_math_arg_lst(LArg, LValue, WamInst, WamMath), WamInst = [call_c(Name, [fast_call,x(Reg)], LValue)|WamNext]. load_math_expr1(F, N, _, _, _, _) :- math_exp_functor_name(F, N, _), error('arithmetic operation not allowed in fast math (~q)', [F / N]). load_math_expr1(F, N, _, _, _, _) :- error('unknown operation in arithmetic expression (~q)', [F / N]). load_math_arg_lst([], [], WamNext, WamNext). load_math_arg_lst([Arg|LArg], [x(Reg)|LReg], WamNext, WamMath) :- load_math_expr(Arg, Reg, WamLArg, WamMath), load_math_arg_lst(LArg, LReg, WamNext, WamLArg). fast_exp_functor_name(-, 1, 'Pl_Fct_Fast_Neg'). fast_exp_functor_name(inc, 1, 'Pl_Fct_Fast_Inc'). fast_exp_functor_name(dec, 1, 'Pl_Fct_Fast_Dec'). fast_exp_functor_name(+, 2, 'Pl_Fct_Fast_Add'). fast_exp_functor_name(-, 2, 'Pl_Fct_Fast_Sub'). fast_exp_functor_name(*, 2, 'Pl_Fct_Fast_Mul'). fast_exp_functor_name(//, 2, 'Pl_Fct_Fast_Div'). fast_exp_functor_name(rem, 2, 'Pl_Fct_Fast_Rem'). fast_exp_functor_name(mod, 2, 'Pl_Fct_Fast_Mod'). fast_exp_functor_name(div, 2, 'Pl_Fct_Fast_Div2'). fast_exp_functor_name(/\, 2, 'Pl_Fct_Fast_And'). fast_exp_functor_name(\/, 2, 'Pl_Fct_Fast_Or'). fast_exp_functor_name(xor, 2, 'Pl_Fct_Fast_Xor'). fast_exp_functor_name(\, 1, 'Pl_Fct_Fast_Not'). fast_exp_functor_name(<<, 2, 'Pl_Fct_Fast_Shl'). fast_exp_functor_name(>>, 2, 'Pl_Fct_Fast_Shr'). fast_exp_functor_name(lsb, 1, 'Pl_Fct_Fast_LSB'). fast_exp_functor_name(msb, 1, 'Pl_Fct_Fast_MSB'). fast_exp_functor_name(popcount, 1, 'Pl_Fct_Fast_Popcount'). fast_exp_functor_name(abs, 1, 'Pl_Fct_Fast_Abs'). fast_exp_functor_name(sign, 1, 'Pl_Fct_Fast_Sign'). fast_exp_functor_name(gcd, 2, 'Pl_Fct_Fast_GCD'). fast_exp_functor_name(^, 2, 'Pl_Fct_Fast_Integer_Pow'). math_exp_functor_name(-, 1, 'Pl_Fct_Neg'). math_exp_functor_name(inc, 1, 'Pl_Fct_Inc'). math_exp_functor_name(dec, 1, 'Pl_Fct_Dec'). math_exp_functor_name(+, 2, 'Pl_Fct_Add'). math_exp_functor_name(-, 2, 'Pl_Fct_Sub'). math_exp_functor_name(*, 2, 'Pl_Fct_Mul'). math_exp_functor_name(//, 2, 'Pl_Fct_Div'). math_exp_functor_name(/, 2, 'Pl_Fct_Float_Div'). math_exp_functor_name(rem, 2, 'Pl_Fct_Rem'). math_exp_functor_name(mod, 2, 'Pl_Fct_Mod'). math_exp_functor_name(div, 2, 'Pl_Fct_Div2'). math_exp_functor_name(/\, 2, 'Pl_Fct_And'). math_exp_functor_name(\/, 2, 'Pl_Fct_Or'). math_exp_functor_name(xor, 2, 'Pl_Fct_Xor'). math_exp_functor_name(\, 1, 'Pl_Fct_Not'). math_exp_functor_name(<<, 2, 'Pl_Fct_Shl'). math_exp_functor_name(>>, 2, 'Pl_Fct_Shr'). math_exp_functor_name(lsb, 1, 'Pl_Fct_LSB'). math_exp_functor_name(msb, 1, 'Pl_Fct_MSB'). math_exp_functor_name(popcount, 1, 'Pl_Fct_Popcount'). math_exp_functor_name(abs, 1, 'Pl_Fct_Abs'). math_exp_functor_name(sign, 1, 'Pl_Fct_Sign'). math_exp_functor_name(gcd, 2, 'Pl_Fct_GCD'). math_exp_functor_name(min, 2, 'Pl_Fct_Min'). math_exp_functor_name(max, 2, 'Pl_Fct_Max'). math_exp_functor_name(^, 2, 'Pl_Fct_Integer_Pow'). math_exp_functor_name(**, 2, 'Pl_Fct_Pow'). math_exp_functor_name(sqrt, 1, 'Pl_Fct_Sqrt'). math_exp_functor_name(tan, 1, 'Pl_Fct_Tan'). math_exp_functor_name(atan, 1, 'Pl_Fct_Atan'). math_exp_functor_name(atan2, 2, 'Pl_Fct_Atan2'). math_exp_functor_name(cos, 1, 'Pl_Fct_Cos'). math_exp_functor_name(acos, 1, 'Pl_Fct_Acos'). math_exp_functor_name(sin, 1, 'Pl_Fct_Sin'). math_exp_functor_name(asin, 1, 'Pl_Fct_Asin'). math_exp_functor_name(tanh, 1, 'Pl_Fct_Tanh'). math_exp_functor_name(atanh, 1, 'Pl_Fct_Atanh'). math_exp_functor_name(cosh, 1, 'Pl_Fct_Cosh'). math_exp_functor_name(acosh, 1, 'Pl_Fct_Acosh'). math_exp_functor_name(sinh, 1, 'Pl_Fct_Sinh'). math_exp_functor_name(asinh, 1, 'Pl_Fct_Asinh'). math_exp_functor_name(exp, 1, 'Pl_Fct_Exp'). math_exp_functor_name(log, 1, 'Pl_Fct_Log'). math_exp_functor_name(log10, 1, 'Pl_Fct_Log10'). math_exp_functor_name(log, 2, 'Pl_Fct_Log_Radix'). math_exp_functor_name(float, 1, 'Pl_Fct_Float'). math_exp_functor_name(ceiling, 1, 'Pl_Fct_Ceiling'). math_exp_functor_name(floor, 1, 'Pl_Fct_Floor'). math_exp_functor_name(round, 1, 'Pl_Fct_Round'). math_exp_functor_name(truncate, 1, 'Pl_Fct_Truncate'). math_exp_functor_name(float_fractional_part, 1, 'Pl_Fct_Float_Fract_Part'). math_exp_functor_name(float_integer_part, 1, 'Pl_Fct_Float_Integ_Part'). math_exp_functor_name(pi, 0, 'Pl_Fct_PI'). math_exp_functor_name(e, 0, 'Pl_Fct_E'). math_exp_functor_name(epsilon, 0, 'Pl_Fct_Epsilon'). gen_inline_pred(F, 2, LArg, WamNext, WamMath) :- ( g_read(fast_math, t) -> fast_cmp_functor_name(F, Name) ; math_cmp_functor_name(F, Name) ), load_math_arg_lst(LArg, LValue, WamInst, WamMath), WamInst = [call_c(Name, [fast_call, boolean], LValue)|WamNext]. fast_cmp_functor_name(=:=, 'Pl_Blt_Fast_Eq'). fast_cmp_functor_name(=\=, 'Pl_Blt_Fast_Neq'). fast_cmp_functor_name(<, 'Pl_Blt_Fast_Lt'). fast_cmp_functor_name(=<, 'Pl_Blt_Fast_Lte'). fast_cmp_functor_name(>, 'Pl_Blt_Fast_Gt'). fast_cmp_functor_name(>=, 'Pl_Blt_Fast_Gte'). math_cmp_functor_name(=:=, 'Pl_Blt_Eq'). math_cmp_functor_name(=\=, 'Pl_Blt_Neq'). math_cmp_functor_name(<, 'Pl_Blt_Lt'). math_cmp_functor_name(=<, 'Pl_Blt_Lte'). math_cmp_functor_name(>, 'Pl_Blt_Gt'). math_cmp_functor_name(>=, 'Pl_Blt_Gte'). % foreign C call gen_inline_pred('$foreign_call_c', 1, [args(FctName, Return, BipPred, ChcSize, LType)], WamNext, WamInst) :- WamInst = [foreign_call_c(FctName, Return, BipPred, ChcSize, LType)|WamNext]. % call_c/3 management predicates load_c_call_args(LCOpt, LArg, LValue, WamNext, WamArg) :- memberchk(by_value, LCOpt), load_by_value_arg_lst(LArg, LValue, WamNext, WamArg), !. load_c_call_args(_, LArg, LValue, WamNext, WamArg) :- load_by_reg_arg_lst(LArg, LValue, WamNext, WamArg), !. load_by_reg_arg_lst([], [], WamNext, WamNext). load_by_reg_arg_lst([Arg|LArg], [x(Reg)|LReg], WamNext, WamArg) :- gen_load_arg(Arg, Reg, WamLArg, WamArg), load_by_reg_arg_lst(LArg, LReg, WamNext, WamLArg). load_by_value_arg_lst([], [], WamNext, WamNext). load_by_value_arg_lst([Arg|LArg], [Value|LValue], WamNext, WamArg) :- load_by_value_arg(Arg, Value, WamLArg, WamArg), load_by_value_arg_lst(LArg, LValue, WamNext, WamLArg). load_by_value_arg(atm(A), A, WamNext, WamNext). load_by_value_arg(int(N), N, WamNext, WamNext). load_by_value_arg(flt(N), N, WamNext, WamNext). load_by_value_arg(nil, [], WamNext, WamNext). load_by_value_arg(stc('/', 2, [atm(F), int(N)]), F/N, WamNext, WamNext). load_by_value_arg(Arg, x(Reg), WamArg, WamNext) :- gen_load_arg(Arg, Reg, WamArg, WamNext). % Other inlines gen_inline_pred(F, N, LArg, WamNext, WamCallC) :- c_fct_name(F, N, Name, RetType), ( RetType = bool -> LCOpt = [fast_call, boolean] ; LCOpt = [fast_call] ), load_c_call_args(LCOpt, LArg, LValue, WamInst, WamCallC), WamInst = [call_c(Name, LCOpt, LValue)|WamNext]. c_fct_name(var, 1, 'Pl_Blt_Var', bool). c_fct_name(nonvar, 1, 'Pl_Blt_Non_Var', bool). c_fct_name(atom, 1, 'Pl_Blt_Atom', bool). c_fct_name(integer, 1, 'Pl_Blt_Integer', bool). c_fct_name(float, 1, 'Pl_Blt_Float', bool). c_fct_name(number, 1, 'Pl_Blt_Number', bool). c_fct_name(atomic, 1, 'Pl_Blt_Atomic', bool). c_fct_name(compound, 1, 'Pl_Blt_Compound', bool). c_fct_name(callable, 1, 'Pl_Blt_Callable', bool). c_fct_name(ground, 1, 'Pl_Blt_Ground', bool). c_fct_name(is_list, 1, 'Pl_Blt_List', bool). c_fct_name(list, 1, 'Pl_Blt_List', bool). c_fct_name(partial_list, 1, 'Pl_Blt_Partial_List', bool). c_fct_name(list_or_partial_list, 1, 'Pl_Blt_List_Or_Partial_List', bool). c_fct_name(fd_var, 1, 'Pl_Blt_Fd_Var', bool). c_fct_name(non_fd_var, 1, 'Pl_Blt_Non_Fd_Var', bool). c_fct_name(generic_var, 1, 'Pl_Blt_Generic_Var', bool). c_fct_name(non_generic_var, 1, 'Pl_Blt_Non_Generic_Var', bool). c_fct_name(arg, 3, 'Pl_Blt_Arg', bool). c_fct_name(functor, 3, 'Pl_Blt_Functor', bool). c_fct_name(compare, 3, 'Pl_Blt_Compare', bool). c_fct_name(=.., 2, 'Pl_Blt_Univ', bool). c_fct_name(==, 2, 'Pl_Blt_Term_Eq', bool). c_fct_name(\==, 2, 'Pl_Blt_Term_Neq', bool). c_fct_name(@<, 2, 'Pl_Blt_Term_Lt', bool). c_fct_name(@=<, 2, 'Pl_Blt_Term_Lte', bool). c_fct_name(@>, 2, 'Pl_Blt_Term_Gt', bool). c_fct_name(@>=, 2, 'Pl_Blt_Term_Gte', bool). c_fct_name(g_assign, 2, 'Pl_Blt_G_Assign', void). c_fct_name(g_assignb, 2, 'Pl_Blt_G_Assignb', void). c_fct_name(g_link, 2, 'Pl_Blt_G_Link', void). c_fct_name(g_read, 2, 'Pl_Blt_G_Read', bool). c_fct_name(g_array_size, 2, 'Pl_Blt_G_Array_Size', bool). c_fct_name(g_inc, 1, 'Pl_Blt_G_Inc', void). c_fct_name(g_inco, 2, 'Pl_Blt_G_Inco', bool). c_fct_name(g_inc, 2, 'Pl_Blt_G_Inc_2', bool). c_fct_name(g_inc, 3, 'Pl_Blt_G_Inc_3', bool). c_fct_name(g_dec, 1, 'Pl_Blt_G_Dec', void). c_fct_name(g_deco, 2, 'Pl_Blt_G_Deco', bool). c_fct_name(g_dec, 2, 'Pl_Blt_G_Dec_2', bool). c_fct_name(g_dec, 3, 'Pl_Blt_G_Dec_3', bool). c_fct_name(g_set_bit, 2, 'Pl_Blt_G_Set_Bit', void). c_fct_name(g_reset_bit, 2, 'Pl_Blt_G_Reset_Bit', void). c_fct_name(g_test_set_bit, 2, 'Pl_Blt_G_Test_Set_Bit', bool). c_fct_name(g_test_reset_bit, 2, 'Pl_Blt_G_Test_Reset_Bit', bool). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/wam_emit.wam���������������������������������������������������������������0000644�0001750�0001750�00000060323�13021356407�015530� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : wam_emit.pl file_name('/home/diaz/GP/src/Pl2Wam/wam_emit.pl'). predicate(user:emit_code_init/2,103,static,private,monofile,global,[ allocate(6), get_variable(y(0),0), put_value(x(1),0), put_variable(y(1),1), call(prolog_file_name/2), put_value(y(0),0), put_value(y(1),1), put_variable(y(2),2), call(emit_code_files/3), put_value(y(2),0), put_variable(y(3),1), call('$emit_code_init/2_$aux1'/2), put_atom(streamwamfile,0), put_value(y(3),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(cur_pl_file,0), put_atom('',1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_variable(y(4),0), call(prolog_name/1), put_variable(y(5),0), call(prolog_version/1), put_value(y(3),0), put_atom('%% compiler: ~a ~a~n',1), put_list(2), unify_local_value(y(4)), unify_list, unify_local_value(y(5)), unify_nil, call(format/3), put_value(y(3),0), put_atom('%% file : ~a~n',1), put_list(2), unify_local_value(y(1)), unify_nil, call(format/3), put_atom(wam_comment,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_unsafe_value(y(3),1), deallocate, execute('$emit_code_init/2_$aux2'/2)]). predicate(user:'$emit_code_init/2_$aux2'/2,103,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom('',0), cut(x(2)), proceed, label(1), trust_me_else_fail, put_list(2), unify_local_value(x(0)), unify_nil, put_value(x(1),0), put_atom('%% ~a~n',1), execute(format/3)]). predicate(user:'$emit_code_init/2_$aux1'/2,103,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(user,0), cut(x(2)), put_value(x(1),0), execute(current_output/1), label(1), trust_me_else_fail, put_value(x(1),2), put_atom(write,1), execute(open/3)]). predicate(user:emit_code_files/3,126,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(7), switch_on_term(3,1,fail,fail,fail), label(1), switch_on_atom([('',2)]), label(2), try(4), trust(6), label(3), try_me_else(5), label(4), get_atom('',0), get_atom(user,1), get_atom(user,2), cut(x(3)), proceed, label(5), trust_me_else_fail, label(6), allocate(4), get_atom('',0), get_variable(y(0),2), cut(x(3)), put_value(x(1),0), put_void(1), put_variable(y(1),2), put_variable(y(2),3), call(decompose_file_name/4), put_variable(y(3),0), call('$emit_code_files/3_$aux1'/1), put_unsafe_value(y(2),0), put_unsafe_value(y(1),1), put_unsafe_value(y(3),2), put_value(y(0),3), deallocate, execute('$emit_code_files/3_$aux2'/4), label(7), trust_me_else_fail, get_value(x(2),0), proceed]). predicate(user:'$emit_code_files/3_$aux2'/4,129,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), call('$prolog_file_suffix'/1), cut(y(3)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(atom_concat/3), label(1), trust_me_else_fail, allocate(3), get_variable(y(0),2), get_variable(y(1),3), get_variable(x(2),1), get_variable(x(1),0), put_value(x(2),0), put_variable(y(2),2), call(atom_concat/3), put_unsafe_value(y(2),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(atom_concat/3)]). predicate(user:'$emit_code_files/3_$aux1'/1,129,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), put_atom(native_code,2), put_atom(t,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), cut(x(1)), get_atom('.wam',0), proceed, label(1), trust_me_else_fail, get_atom('.wbc',0), proceed]). predicate(user:emit_code_term/2,156,static,private,monofile,global,[ allocate(2), get_variable(y(0),1), put_atom(streamwamfile,1), put_variable(y(1),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_value(x(0),1), put_value(y(1),0), call(character_count/2), put_value(y(1),0), put_value(y(0),1), call(line_count/2), put_unsafe_value(y(1),0), deallocate, execute(close/1)]). predicate(user:emit_code/5,165,static,private,monofile,global,[ allocate(2), get_variable(y(0),4), put_atom(streamwamfile,4), put_variable(y(1),5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), put_value(y(1),4), put_void(5), call(emit_pred_start/6), put_value(y(0),0), put_void(1), put_value(y(1),2), call(emit_wam_code/3), put_value(y(1),0), put_atom(']).',1), call(write/2), put_unsafe_value(y(1),0), deallocate, execute(nl/1)]). predicate(user:emit_pred_start/6,175,static,private,monofile,global,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(5), get_integer(0,1), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), get_variable(y(4),6), put_value(y(3),1), call('$emit_pred_start/6_$aux1'/2), cut(y(4)), put_value(y(0),0), put_value(y(2),1), call(emit_file_name_if_needed/2), put_value(y(2),0), put_atom('~n~ndirective(~d,~a,',1), put_list(2), unify_local_value(y(1)), unify_list, unify_local_value(y(3)), unify_nil, deallocate, execute(format/3), label(1), trust_me_else_fail, allocate(9), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),3), get_variable(y(3),4), put_value(x(2),0), put_value(y(3),1), call(emit_file_name_if_needed/2), put_value(y(0),0), put_value(y(1),1), put_variable(y(4),2), call('$emit_pred_start/6_$aux2'/3), put_value(y(0),0), put_value(y(1),1), put_variable(y(5),2), call('$emit_pred_start/6_$aux3'/3), put_value(y(0),0), put_value(y(1),1), put_variable(y(6),2), call('$emit_pred_start/6_$aux4'/3), put_value(y(0),0), put_value(y(1),1), put_variable(y(7),2), call(get_module_of_pred/3), put_value(y(0),0), put_value(y(1),1), put_variable(y(8),2), call(export_type/3), put_value(y(3),0), put_atom('~n~npredicate(~q,~d,~a,~a,~a,~a,',1), put_structure((:)/2,3), unify_local_value(y(7)), unify_structure((/)/2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(2), unify_value(x(3)), unify_list, unify_local_value(y(2)), unify_list, unify_local_value(y(4)), unify_list, unify_local_value(y(5)), unify_list, unify_local_value(y(6)), unify_list, unify_local_value(y(8)), unify_nil, deallocate, execute(format/3)]). predicate(user:'$emit_pred_start/6_$aux4'/3,184,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(x(2),1), get_variable(y(1),3), put_value(x(0),1), put_atom(multi,0), call(test_pred_info/3), cut(y(1)), put_value(y(0),0), get_atom(multifile,0), deallocate, proceed, label(1), trust_me_else_fail, get_atom(monofile,2), proceed]). predicate(user:'$emit_pred_start/6_$aux3'/3,184,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(x(2),1), get_variable(y(1),3), put_value(x(0),1), put_atom(pub,0), call(test_pred_info/3), cut(y(1)), put_value(y(0),0), get_atom(public,0), deallocate, proceed, label(1), trust_me_else_fail, get_atom(private,2), proceed]). predicate(user:'$emit_pred_start/6_$aux2'/3,184,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(x(2),1), get_variable(y(1),3), put_value(x(0),1), put_atom(dyn,0), call(test_pred_info/3), cut(y(1)), put_value(y(0),0), get_atom(dynamic,0), deallocate, proceed, label(1), trust_me_else_fail, get_atom(static,2), proceed]). predicate(user:'$emit_pred_start/6_$aux1'/2,175,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([('$exe_user',3),('$exe_system',5)]), label(2), try_me_else(4), label(3), get_atom('$exe_user',0), get_atom(user,1), proceed, label(4), trust_me_else_fail, label(5), get_atom('$exe_system',0), get_atom(system,1), proceed]). predicate(user:export_type/3,205,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_atom(local,2), get_variable(y(0),3), call('$aux_name'/1), cut(y(0)), deallocate, proceed, label(1), retry_me_else(2), allocate(1), get_atom(local,2), get_variable(x(2),1), get_variable(y(0),3), put_value(x(0),1), put_atom(multi,0), call(test_pred_info/3), cut(y(0)), deallocate, proceed, label(2), retry_me_else(3), allocate(1), get_atom(built_in,2), get_variable(x(2),1), get_variable(y(0),3), put_value(x(0),1), put_atom(bpl,0), call(test_pred_info/3), cut(y(0)), deallocate, proceed, label(3), retry_me_else(4), allocate(1), get_atom(built_in_fd,2), get_variable(x(2),1), get_variable(y(0),3), put_value(x(0),1), put_atom(bfd,0), call(test_pred_info/3), cut(y(0)), deallocate, proceed, label(4), retry_me_else(5), get_atom(global,2), put_atom(module_already_seen,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), cut(x(3)), proceed, label(5), retry_me_else(6), allocate(1), get_atom(global,2), get_variable(y(0),3), call(is_exported/2), cut(y(0)), deallocate, proceed, label(6), trust_me_else_fail, get_atom(local,2), proceed]). predicate(user:emit_file_name_if_needed/2,228,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(cur_pl_file,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(0)]), cut(x(2)), proceed, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),0), put_value(x(1),0), put_atom('~n~nfile_name(~q).~n',1), put_list(2), unify_local_value(y(0)), unify_nil, call(format/3), put_atom(cur_pl_file,0), put_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed]). predicate(user:emit_wam_code/3,238,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(5), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(3),3), put_value(y(1),1), put_value(y(2),2), call(emit_wam_code/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), call(emit_wam_code/3), cut(y(3)), deallocate, proceed, label(5), retry_me_else(6), allocate(3), get_variable(y(0),1), get_variable(y(1),2), put_variable(y(2),1), call(special_form/2), put_unsafe_value(y(2),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(emit_wam_code/3), label(6), retry_me_else(7), allocate(1), get_variable(y(0),3), put_atom(keep_void_inst,2), put_variable(x(1),3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), call(dummy_instruction/2), cut(y(0)), deallocate, proceed, label(7), retry_me_else(8), allocate(3), get_variable(y(0),0), get_variable(y(1),2), put_value(y(0),0), get_structure(label/1,0), unify_void(1), cut(x(3)), put_value(x(1),0), put_variable(y(2),1), call('$emit_wam_code/3_$aux1'/2), put_value(y(1),0), put_atom('~a~n~n',1), put_list(2), unify_local_value(y(2)), unify_nil, call(format/3), put_value(y(0),0), put_value(y(1),1), deallocate, execute(emit_one_inst/2), label(8), trust_me_else_fail, allocate(3), get_variable(y(0),0), get_variable(y(1),2), put_value(x(1),0), put_variable(y(2),1), call('$emit_wam_code/3_$aux2'/2), put_value(y(1),0), put_atom('~a~n ',1), put_list(2), unify_local_value(y(2)), unify_nil, call(format/3), put_value(y(0),0), put_value(y(1),1), deallocate, execute(emit_one_inst/2)]). predicate(user:'$emit_wam_code/3_$aux2'/2,262,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), get_atom('[',1), get_atom(f,0), proceed, label(1), trust_me_else_fail, get_atom(',',1), proceed]). predicate(user:'$emit_wam_code/3_$aux1'/2,252,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), get_atom('[',1), get_atom(f,0), proceed, label(1), trust_me_else_fail, get_atom(',',1), proceed]). predicate(user:emit_one_inst/2,274,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_variable(x(3),1), get_variable(x(1),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(1)]), cut(x(2)), put_value(x(3),0), execute(writeq/2), label(1), trust_me_else_fail, allocate(3), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), put_variable(x(1),2), put_variable(y(2),3), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(2),x(3)]), put_value(y(1),0), call(writeq/2), put_integer(0,0), put_value(y(2),1), put_value(y(0),2), put_value(y(1),3), call(emit_args/4), put_value(y(1),0), put_atom(')',1), deallocate, execute(write/2)]). predicate(user:emit_args/4,284,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_value(x(1),0), cut(x(4)), proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), math_fast_load_value(x(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_variable(y(3),0), put_value(y(3),0), put_value(y(2),1), call('$emit_args/4_$aux1'/2), put_value(y(3),1), put_value(y(1),2), put_variable(x(0),3), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(1),x(2),x(3)]), put_value(y(2),1), call(emit_one_arg/2), put_unsafe_value(y(3),0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), deallocate, execute(emit_args/4)]). predicate(user:'$emit_args/4_$aux1'/2,287,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_integer(1,0), cut(x(2)), put_value(x(1),0), put_atom('(',1), execute(put_char/2), label(1), trust_me_else_fail, put_value(x(1),0), put_atom(',',1), execute(put_char/2)]). predicate(user:emit_one_arg/2,297,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(6), get_list(0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),1), get_variable(y(3),2), put_value(y(1),0), put_variable(y(4),1), call(length/2), math_fast_load_value(y(4),0), put_integer(30,1), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(1)]), cut(y(3)), put_value(y(2),0), put_atom('[',1), call(put_char/2), put_value(y(2),0), put_variable(y(5),1), call(line_position/2), put_value(y(2),0), put_value(y(0),1), put_structure(quoted/1,4), unify_atom(true), put_structure(priority/1,3), unify_integer(999), put_list(2), unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, call(write_term/3), put_value(y(1),0), put_unsafe_value(y(5),1), put_value(y(2),2), deallocate, execute(emit_list/3), label(1), retry_me_else(2), allocate(1), get_variable(y(0),2), put_atom(native_code,2), put_atom(f,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), call(emit_one_f_n/2), cut(y(0)), deallocate, proceed, label(2), trust_me_else_fail, get_variable(x(2),1), get_variable(x(1),0), put_value(x(2),0), execute(writeq/2)]). predicate(user:emit_one_f_n/2,320,static,private,monofile,global,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([((:)/2,3),((/)/2,5)]), label(2), try_me_else(4), label(3), get_structure((:)/2,0), unify_variable(x(4)), unify_structure((/)/2), unify_variable(x(3)), unify_variable(x(0)), put_list(2), unify_value(x(4)), unify_list, unify_value(x(3)), unify_list, unify_value(x(0)), unify_nil, put_value(x(1),0), put_atom('(~q):(~q)/~q',1), execute(format/3), label(4), trust_me_else_fail, label(5), get_structure((/)/2,0), unify_variable(x(3)), unify_variable(x(0)), put_list(2), unify_value(x(3)), unify_list, unify_value(x(0)), unify_nil, put_value(x(1),0), put_atom('(~q)/~q',1), execute(format/3)]). predicate(user:emit_list/3,329,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), put_value(x(2),0), put_atom(']',1), execute(put_char/2), label(3), trust_me_else_fail, label(4), allocate(4), get_list(0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(2),1), get_variable(y(3),2), put_value(y(3),0), put_atom(',~n~*c',1), put_list(2), unify_local_value(y(2)), unify_list, unify_integer(32), unify_nil, call(format/3), put_value(y(3),0), put_value(y(0),1), put_structure(quoted/1,4), unify_atom(true), put_structure(priority/1,3), unify_integer(999), put_list(2), unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, call(write_term/3), put_value(y(1),0), put_value(y(2),1), put_value(y(3),2), deallocate, execute(emit_list/3)]). predicate(user:emit_ensure_linked/0,340,static,private,monofile,global,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), allocate(4), get_variable(y(0),0), put_atom(streamwamfile,0), put_variable(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_structure(ensure_linked/2,0), unify_variable(y(2)), unify_variable(y(3)), put_meta_term(user,0,0), call(retract/1), cut(y(0)), put_value(y(1),0), put_atom('~n~nensure_linked([~q',1), put_structure((/)/2,3), unify_value(y(2)), unify_value(y(3)), put_list(2), unify_value(x(3)), unify_nil, call(format/3), put_value(y(1),0), call('$emit_ensure_linked/0_$aux1'/1), put_value(y(1),0), put_atom(']).',1), call(write/2), put_unsafe_value(y(1),0), deallocate, execute(nl/1), label(1), trust_me_else_fail, proceed]). predicate(user:'$emit_ensure_linked/0_$aux1'/1,340,static,private,monofile,local,[ try_me_else(1), allocate(3), get_variable(y(0),0), put_structure(ensure_linked/2,0), unify_variable(y(1)), unify_variable(y(2)), put_meta_term(user,0,0), put_void(1), call(clause/2), put_value(y(0),0), put_atom(',~q',1), put_structure((/)/2,3), unify_value(y(1)), unify_value(y(2)), put_list(2), unify_value(x(3)), unify_nil, call(format/3), fail, label(1), trust_me_else_fail, proceed]). predicate(user:bc_emit_code/5,357,static,private,monofile,global,[ allocate(3), get_variable(y(0),4), put_atom(streamwamfile,4), put_variable(y(1),5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), put_value(y(1),4), put_variable(y(2),5), call(emit_pred_start/6), put_unsafe_value(y(2),0), put_value(y(0),1), put_unsafe_value(y(1),2), deallocate, execute('$bc_emit_code/5_$aux1'/3)]). predicate(user:'$bc_emit_code/5_$aux1'/3,357,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),2), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(3)), get_list(1), unify_variable(x(0)), unify_nil, get_structure(bc/2,0), unify_variable(x(0)), unify_void(1), get_structure((:-)/2,0), unify_void(1), unify_variable(x(1)), put_value(y(0),0), call(bc_emit_prolog_term/2), put_value(y(0),0), put_atom(').~n',1), put_nil(2), deallocate, execute(format/3), label(1), trust_me_else_fail, allocate(5), get_variable(y(0),1), get_variable(y(1),2), put_value(y(0),0), put_variable(y(2),1), call(length/2), put_value(y(0),0), put_variable(y(3),1), put_variable(y(4),2), put_value(y(2),3), call('$bc_emit_code/5_$aux2'/4), put_value(y(1),0), put_atom('~d).~n',1), put_list(2), unify_local_value(y(3)), unify_nil, call(format/3), put_unsafe_value(y(4),0), put_value(y(1),1), deallocate, execute(bc_emit_lst_clause/2)]). predicate(user:'$bc_emit_code/5_$aux2'/4,357,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_list(0), unify_variable(x(0)), unify_nil, get_structure(bc/2,0), unify_atom('$$empty$$predicate$$clause$$'), unify_list, unify_atom(proceed), unify_nil, cut(x(4)), get_integer(0,1), get_nil(2), proceed, label(1), trust_me_else_fail, get_value(x(3),1), get_value(x(0),2), proceed]). predicate(user:bc_emit_lst_clause/2,378,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_list(0), unify_variable(x(0)), unify_variable(y(2)), get_structure(bc/2,0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(3),1), put_value(y(3),0), put_atom('~n~nclause(',1), put_nil(2), call(format/3), put_value(y(3),0), put_value(y(0),1), call(bc_emit_prolog_term/2), put_value(y(3),0), put_atom(',',1), call(write/2), put_value(y(1),0), put_void(1), put_value(y(3),2), call(emit_wam_code/3), put_value(y(3),0), put_atom(']).~n',1), put_nil(2), call(format/3), put_value(y(2),0), put_value(y(3),1), deallocate, execute(bc_emit_lst_clause/2)]). predicate(user:bc_emit_prolog_term/2,391,static,private,monofile,global,[ try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), put_variable(y(2),0), call('$get_current_B'/1), put_value(y(1),0), call(name_singleton_vars/1), put_value(y(1),0), put_structure(exclude/1,2), unify_list, unify_local_value(y(1)), unify_nil, put_list(1), unify_value(x(2)), unify_nil, call(bind_variables/2), put_value(y(0),0), put_value(y(1),1), put_structure(numbervars/1,7), unify_atom(true), put_structure(namevars/1,6), unify_atom(true), put_structure('$above'/1,5), unify_local_value(y(2)), put_structure(ignore_ops/1,4), unify_atom(true), put_structure(quoted/1,3), unify_atom(true), put_list(2), unify_value(x(7)), unify_list, unify_value(x(6)), unify_list, unify_value(x(5)), unify_list, unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, call(write_term/3), fail, label(1), trust_me_else_fail, proceed]). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/sicslib.pl�����������������������������������������������������������������0000644�0001750�0001750�00000001266�13021324543�015202� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� prolog_name('SICStus Prolog'). prolog_version(X) :- current_prolog_flag(version, X). prolog_date('2000'). prolog_copyright(''). g_assign(Var, Value) :- bb_put(Var, Value). g_read(Var, Value) :- ( bb_get(Var, Value1) ; Value1 = 0 ), !, Value = Value1. argument_list(LArgs) :- current_prolog_flag(argv, LArgs). reverse([], []). reverse([H|T], L) :- reverse1(T, L, [H]). reverse1([], L, L). reverse1([H|T], L, L1) :- reverse1(T, L, [H|L1]). append([], L, L). append([X|L1], L2, [X|L3]) :- append(L1, L2, L3). % execution go_other :- argument_list(L), go_other1(L). go_other1([]) :- !. go_other1(L) :- pl2wam(L), halt. :- initialization(go_other). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/Makefile.in����������������������������������������������������������������0000644�0001750�0001750�00000003215�13021324543�015256� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GPLC = @GPLC@ GPLCFLAGS = --fast-math CFLAGS = @CFLAGS@ PLS = pl2wam.pl read_file.pl syn_sugar.pl internal.pl \ code_gen.pl reg_alloc.pl inst_codif.pl first_arg.pl \ indexing.pl wam_emit.pl OBJS = $(PLS:.pl=@OBJ_SUFFIX@) WAMS = $(PLS:.pl=.wam) .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .wam .pl $(SUFFIXES) .pl.wam: $(GPLC) -W $(GPLCFLAGS) $*.pl .wam@OBJ_SUFFIX@: $(GPLC) -c $*.wam pl2wam@EXE_SUFFIX@: $(OBJS) [ ! -f pl2wam@EXE_SUFFIX@ ] || cp pl2wam@EXE_SUFFIX@ pl2wam0@EXE_SUFFIX@ $(GPLC) -o pl2wam@EXE_SUFFIX@ --no-fd-lib-warn --no-top-level $(OBJS) # in stage 2 we simply re-link pl2wam since now the FD lib should be present # (needed to test FD built-in redefinitions via predicate_property) stage2: [ ! -f pl2wam@EXE_SUFFIX@ ] || cp pl2wam@EXE_SUFFIX@ pl2wam0@EXE_SUFFIX@ rm -rf pl2wam@EXE_SUFFIX@ $(MAKE) clean: [ ! -f pl2wam@EXE_SUFFIX@ ] || mv pl2wam@EXE_SUFFIX@ pl2wam0@EXE_SUFFIX@ rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp clean-wam: rm -f *.wam clean-full: clean-wam clean distclean: clean rm -f pl2wam@EXE_SUFFIX@ pl2wam0@EXE_SUFFIX@ pl2wam.wam: pl2wam.pl read_file.wam: read_file.pl syn_sugar.wam: syn_sugar.pl internal.wam: internal.pl code_gen.wam: code_gen.pl reg_alloc.wam: reg_alloc.pl inst_codif.wam: inst_codif.pl first_arg.wam: first_arg.pl indexing.wam: indexing.pl wam_emit.wam: wam_emit.pl check: @./check_boot -a [a-z][a-z]*.wam && echo Bootstrap Prolog Compiler OK swi_pl2wam: swilib.pl $(PLS) pl -o swi_pl2wam_main -c swilib.pl $(PLS) echo "#!/bin/sh" >swi_pl2wam echo 'swi_pl2wam_main -g go -t halt -- $$*' >>swi_pl2wam chmod a+x swi_pl2wam �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Pl2Wam/read_file.wam��������������������������������������������������������������0000644�0001750�0001750�00000333725�13021356407�015651� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : read_file.pl file_name('/home/diaz/GP/src/Pl2Wam/read_file.pl'). predicate(user:read_file_init/1,129,static,private,monofile,global,[ allocate(1), get_variable(y(0),0), put_structure(buff_clause/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_structure(buff_aux_pred/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_structure(buff_discontig_clause/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_structure(buff_dyn_interf_clause/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_structure(buff_exe_system/1,0), unify_void(1), put_meta_term(user,0,0), call(retractall/1), put_structure(buff_exe_user/1,0), unify_void(1), put_meta_term(user,0,0), call(retractall/1), put_structure(empty_dyn_pred/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_structure(ensure_linked/2,0), unify_void(2), put_meta_term(user,0,0), call(retractall/1), put_structure(pred_info/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_structure(module_export/2,0), unify_void(2), put_meta_term(user,0,0), call(retractall/1), put_structure(module_import/4,0), unify_void(4), put_meta_term(user,0,0), call(retractall/1), put_structure(meta_pred/3,0), unify_void(3), put_meta_term(user,0,0), call(retractall/1), put_atom(module,0), put_atom(user,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(module_already_seen,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(default_kind,0), put_atom(user,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(reading_dyn_pred,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(eof_reached,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(open_file_stack,0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(if_stack,0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(where,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(syn_error_nb,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(in_lines,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(in_bytes,0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), deallocate, execute(open_new_prolog_file/1)]). predicate(user:read_file_term/2,158,static,private,monofile,global,[ put_atom(in_bytes,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(0)]), put_atom(in_lines,0), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(user:read_file_error_nb/1,165,static,private,monofile,global,[ put_atom(syn_error_nb,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(0)]), proceed]). predicate(user:open_new_prolog_file/1,171,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), allocate(5), get_variable(y(0),1), put_atom(open_file_stack,1), put_variable(y(1),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_variable(y(2),1), call(prolog_file_name/2), put_value(y(2),0), put_value(y(1),1), put_variable(y(3),2), put_variable(y(4),3), call(open_new_prolog_file1/4), cut(y(0)), put_atom(open_file_stack,0), put_structure((*)/2,2), unify_local_value(y(3)), unify_local_value(y(4)), put_list(1), unify_value(x(2)), unify_local_value(y(1)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_unsafe_value(y(4),0), deallocate, execute('$open_new_prolog_file/1_$aux1'/1)]). predicate(user:'$open_new_prolog_file/1_$aux1'/1,171,static,private,monofile,local,[ try_me_else(1), allocate(2), get_variable(y(0),0), put_value(y(0),0), put_atom(#,1), call(peek_char/2), call(repeat/0), put_value(y(0),0), put_variable(y(1),1), call(get_char/2), put_unsafe_value(y(1),0), deallocate, execute('$open_new_prolog_file/1_$aux2'/1), label(1), trust_me_else_fail, proceed]). predicate(user:'$open_new_prolog_file/1_$aux2'/1,171,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([('\n',3),(end_of_file,5)]), label(2), try_me_else(4), label(3), get_atom('\n',0), proceed, label(4), trust_me_else_fail, label(5), get_atom(end_of_file,0), proceed]). predicate(user:open_new_prolog_file1/4,185,static,private,monofile,global,[ try_me_else(1), get_atom(user,0), get_atom(user,2), put_value(x(3),0), execute(current_input/1), label(1), retry_me_else(2), get_value(x(2),0), put_structure(open/3,0), unify_local_value(x(2)), unify_atom(read), unify_local_value(x(3)), put_structure(existence_error/2,2), unify_atom(source_sink), unify_void(1), put_structure(error/2,1), unify_value(x(2)), unify_void(1), put_atom(fail,2), put_atom(user,3), put_atom(open_new_prolog_file1,4), put_integer(4,5), execute('$catch'/6), label(2), retry_me_else(3), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), call(is_relative_file_name/1), put_value(y(1),0), put_value(y(0),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute(try_other_directory/4), label(3), trust_me_else_fail, put_structure(existence_error/2,1), unify_atom(source_sink), unify_local_value(x(0)), put_structure(error/2,0), unify_value(x(1)), unify_structure((/)/2), unify_atom(open), unify_integer(3), put_atom(user,1), put_atom(open_new_prolog_file1,2), put_integer(4,3), execute('$throw'/4)]). predicate(user:try_other_directory/4,205,static,private,monofile,global,[ switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_list(0), unify_variable(x(0)), unify_void(1), get_structure((*)/2,0), unify_variable(x(0)), unify_void(1), put_variable(y(3),1), put_void(2), put_void(3), call(decompose_file_name/4), put_value(y(3),0), put_atom('',1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(3),0), put_value(y(0),1), put_value(y(1),2), call(atom_concat/3), put_structure(open/3,0), unify_local_value(y(1)), unify_atom(read), unify_local_value(y(2)), put_void(1), put_atom(fail,2), put_atom(user,3), put_atom(try_other_directory,4), put_integer(4,5), deallocate, execute('$catch'/6), label(4), trust_me_else_fail, label(5), get_list(0), unify_void(1), unify_variable(x(0)), execute(try_other_directory/4)]). predicate(user:close_last_prolog_file/0,220,static,private,monofile,global,[ allocate(5), put_atom(open_file_stack,0), put_structure((*)/2,1), unify_void(1), unify_variable(y(0)), put_list(2), unify_value(x(1)), unify_variable(x(1)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), put_atom(open_file_stack,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(in_bytes,0), put_variable(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(in_lines,0), put_variable(y(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_variable(y(3),1), call(character_count/2), put_value(y(0),0), put_variable(y(4),1), call(line_count/2), math_fast_load_value(y(1),0), math_fast_load_value(y(3),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(2)],[x(0),x(1)]), math_fast_load_value(y(2),0), math_fast_load_value(y(4),1), call_c('Pl_Fct_Fast_Add',[fast_call,x(1)],[x(0),x(1)]), put_atom(in_bytes,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(2)]), put_atom(in_lines,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), deallocate, execute(close/1)]). predicate(user:read_predicate/3,238,static,private,monofile,global,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call(repeat/0), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), call(read_predicate1/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute('$read_predicate/3_$aux1'/3)]). predicate(user:'$read_predicate/3_$aux1'/3,238,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), put_atom(reading_dyn_pred,4), put_atom(f,5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), put_atom(native_code,4), put_atom(t,5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), execute(read_predicate_next/3), label(1), trust_me_else_fail, proceed]). predicate(user:read_predicate_next/3,251,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), put_value(y(1),1), call('$read_predicate_next/3_$aux1'/2), cut(y(3)), put_value(y(2),0), get_list(0), unify_variable(x(0)), unify_void(1), get_structure((+)/2,0), unify_variable(x(2)), unify_void(1), put_value(y(0),0), put_value(y(1),1), call(add_dyn_interf_clause/3), put_value(y(2),0), put_value(y(0),1), put_value(y(1),2), call(create_exe_clauses_for_dyn_pred/3), fail, label(1), retry_me_else(2), allocate(2), get_variable(y(0),2), get_variable(x(2),1), get_variable(y(1),3), put_value(x(0),1), put_atom(pub,0), call(test_pred_info/3), cut(y(1)), put_value(y(0),0), deallocate, execute(create_exe_clauses_for_pub_pred/1), label(2), trust_me_else_fail, proceed]). predicate(user:'$read_predicate_next/3_$aux1'/2,251,static,private,monofile,local,[ try_me_else(1), get_variable(x(2),1), put_value(x(0),1), put_atom(dyn,0), execute(test_pred_info/3), label(1), trust_me_else_fail, get_variable(x(2),1), put_value(x(0),1), put_atom(multi,0), execute(test_pred_info/3)]). predicate(user:read_predicate1/3,267,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),3), put_structure(buff_aux_pred/3,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), put_meta_term(user,3,0), call(retract/1), cut(y(0)), deallocate, proceed, label(1), retry_me_else(2), allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_atom(eof_reached,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), cut(y(3)), call(repeat/0), put_value(y(0),0), put_value(y(1),1), put_variable(y(4),2), call(get_next_clause/3), put_value(y(4),0), get_structure((+)/2,0), unify_void(1), unify_variable(y(5)), put_structure(empty_dyn_pred/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_void(1), put_meta_term(user,0,0), call(retractall/1), put_value(y(0),0), put_value(y(1),1), put_value(y(4),2), call('$read_predicate1/3_$aux1'/3), put_value(y(0),0), put_value(y(1),1), call('$read_predicate1/3_$aux2'/2), cut(y(3)), put_value(y(5),0), put_atom(end_of_file,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), call(define_predicate/2), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(4),2), put_value(y(2),3), deallocate, execute(group_clauses_by_pred/4), label(2), retry_me_else(3), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_list(2), unify_variable(x(1)), unify_variable(y(2)), get_variable(y(3),3), put_structure(buff_discontig_clause/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_value(x(1)), put_meta_term(user,0,0), call(retract/1), cut(y(3)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(recover_discontig_clauses/3), label(3), retry_me_else(4), allocate(1), get_list(2), unify_variable(x(4)), unify_nil, get_variable(y(0),3), put_atom(reading_dyn_pred,2), put_atom(t,3), call_c('Pl_Blt_G_Assign',[fast_call],[x(2),x(3)]), put_structure(buff_dyn_interf_clause/3,2), unify_local_value(x(0)), unify_local_value(x(1)), unify_value(x(4)), put_meta_term(user,2,0), call(retract/1), cut(y(0)), deallocate, proceed, label(4), retry_me_else(5), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_list(2), unify_variable(y(2)), unify_nil, get_variable(y(3),3), put_atom(reading_dyn_pred,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_structure(empty_dyn_pred/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_variable(y(4)), put_meta_term(user,0,0), call(retract/1), put_value(y(0),0), put_value(y(1),1), call(define_predicate/2), put_value(y(0),0), put_value(y(1),1), put_value(y(4),2), put_value(y(2),3), call('$read_predicate1/3_$aux3'/4), cut(y(3)), deallocate, proceed, label(5), retry_me_else(6), allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_atom(reading_dyn_pred,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_structure(buff_exe_system/1,0), unify_structure((+)/2), unify_variable(y(4)), unify_variable(y(5)), put_meta_term(user,0,0), call(retract/1), put_value(y(0),0), get_atom('$exe_system',0), put_value(y(1),0), get_integer(0,0), put_value(y(2),0), get_list(0), unify_variable(x(0)), unify_nil, get_structure((+)/2,0), unify_value(y(4)), unify_structure((:-)/2), unify_local_value(y(0)), unify_value(y(5)), cut(y(3)), deallocate, proceed, label(6), retry_me_else(7), allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_structure(buff_exe_user/1,0), unify_structure((+)/2), unify_variable(y(4)), unify_variable(y(5)), put_meta_term(user,0,0), call(retract/1), put_value(y(0),0), get_atom('$exe_user',0), put_value(y(1),0), get_integer(0,0), put_value(y(2),0), get_list(0), unify_variable(x(0)), unify_nil, get_structure((+)/2,0), unify_value(y(4)), unify_structure((:-)/2), unify_local_value(y(0)), unify_value(y(5)), cut(y(3)), deallocate, proceed, label(7), trust_me_else_fail, get_atom(end_of_file,0), get_integer(0,1), get_nil(2), cut(x(3)), proceed]). predicate(user:'$read_predicate1/3_$aux3'/4,301,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), put_atom(native_code,5), put_atom(t,6), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(5),x(6)]), cut(x(4)), execute(create_dyn_interf_clause/4), label(1), trust_me_else_fail, get_structure((+)/2,3), unify_local_value(x(2)), unify_atom('$$empty$$predicate$$clause$$'), proceed]). predicate(user:'$read_predicate1/3_$aux2'/2,271,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(def,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(2)), put_atom('discontiguous predicate ~q - clause ignored',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, call(warn/2), fail, label(1), trust_me_else_fail, proceed]). predicate(user:'$read_predicate1/3_$aux1'/3,271,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_atom(discontig,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(3)), put_structure(buff_discontig_clause/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(y(2)), put_meta_term(user,0,0), call(assertz/1), put_value(y(0),0), put_value(y(1),1), call(define_predicate/2), fail, label(1), trust_me_else_fail, proceed]). predicate(user:group_clauses_by_pred/4,332,static,private,monofile,global,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_list(3), unify_local_value(x(2)), unify_variable(y(2)), put_variable(y(3),0), put_variable(y(4),1), put_variable(y(5),2), call(get_next_clause/3), put_value(y(0),0), put_unsafe_value(y(3),1), put_value(y(1),2), put_unsafe_value(y(4),3), put_unsafe_value(y(5),4), put_value(y(2),5), deallocate, execute('$group_clauses_by_pred/4_$aux1'/6)]). predicate(user:'$group_clauses_by_pred/4_$aux1'/6,332,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), get_value(x(1),0), get_value(x(3),2), cut(x(6)), put_value(x(1),0), put_value(x(3),1), put_value(x(4),2), put_value(x(5),3), execute(group_clauses_by_pred/4), label(1), trust_me_else_fail, get_nil(5), put_value(x(1),0), put_value(x(3),1), put_value(x(4),2), execute('$group_clauses_by_pred/4_$aux2'/3)]). predicate(user:'$group_clauses_by_pred/4_$aux2'/3,332,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom(end_of_file,0), get_integer(0,1), cut(x(3)), proceed, label(1), trust_me_else_fail, put_structure(buff_clause/3,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), put_meta_term(user,3,0), execute(asserta/1)]). predicate(user:add_dyn_interf_clause/3,348,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),3), put_structure(buff_dyn_interf_clause/3,2), unify_local_value(x(0)), unify_local_value(x(1)), unify_void(1), put_meta_term(user,2,0), put_atom(true,1), call(clause/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, allocate(3), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), put_value(y(1),1), put_variable(y(2),3), call(create_dyn_interf_clause/4), put_structure(buff_dyn_interf_clause/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(y(2)), put_meta_term(user,0,0), deallocate, execute(assertz/1)]). predicate(user:create_dyn_interf_clause/4,358,static,private,monofile,global,[ allocate(4), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), put_variable(y(3),0), call(length/2), put_variable(x(0),1), put_list(2), unify_local_value(y(0)), unify_local_value(y(3)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(1),x(2)]), put_value(y(2),1), get_structure((+)/2,1), unify_local_value(y(1)), unify_structure((:-)/2), unify_value(x(0)), unify_structure(call/1), unify_value(x(0)), deallocate, proceed]). predicate(user:recover_discontig_clauses/3,366,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_list(2), unify_variable(x(1)), unify_variable(y(2)), get_variable(y(3),3), put_structure(buff_discontig_clause/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_value(x(1)), put_meta_term(user,0,0), call(retract/1), cut(y(3)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(recover_discontig_clauses/3), label(1), trust_me_else_fail, get_nil(2), proceed]). predicate(user:create_exe_clauses_for_dyn_pred/3,375,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(8), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure((+)/2,0), unify_variable(y(3)), unify_variable(y(4)), put_value(y(3),0), put_variable(y(5),1), call(get_file_name/2), put_value(y(1),0), put_value(y(2),1), put_structure((+)/2,2), unify_value(y(3)), unify_value(y(4)), put_variable(y(6),3), call(add_wrapper_to_dyn_clause/4), put_value(y(1),0), put_value(y(2),1), put_variable(y(7),2), put_value(y(1),3), call(get_owner_module/4), put_atom(system,0), put_structure('Pl_Emit_BC_Execute_Wrapper'/6,1), unify_local_value(y(7)), unify_local_value(y(1)), unify_local_value(y(2)), unify_atom(&), unify_local_value(y(6)), unify_local_value(y(2)), put_structure('$call_c'/2,2), unify_value(x(1)), unify_list, unify_atom(by_value), unify_nil, put_structure((',')/2,1), unify_value(x(2)), unify_structure('$add_clause_term'/3), unify_local_value(y(7)), unify_value(y(4)), unify_local_value(y(5)), put_value(y(3),2), call(handle_initialization/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(create_exe_clauses_for_dyn_pred/3)]). predicate(user:create_exe_clauses_for_pub_pred/1,388,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_list(0), unify_variable(x(0)), unify_variable(y(2)), get_structure((+)/2,0), unify_variable(y(0)), unify_variable(y(1)), put_value(y(0),0), put_variable(y(3),1), call(get_file_name/2), put_atom(system,0), put_structure('$add_clause_term'/2,1), unify_value(y(1)), unify_local_value(y(3)), put_value(y(0),2), call(handle_initialization/3), put_value(y(2),0), deallocate, execute(create_exe_clauses_for_pub_pred/1)]). predicate(user:get_file_name/2,396,static,private,monofile,global,[ get_structure((+)/2,0), unify_variable(x(0)), unify_void(1), get_list(0), unify_variable(x(0)), unify_void(1), get_structure((*)/2,0), unify_local_value(x(1)), unify_void(1), proceed]). predicate(user:get_next_clause/3,401,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(y(1),3), put_structure(buff_clause/3,2), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(y(0)), put_meta_term(user,2,0), call(retract/1), put_value(y(0),0), get_structure((+)/2,0), unify_variable(x(1)), unify_void(1), put_atom(where,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), cut(y(1)), deallocate, proceed, label(1), trust_me_else_fail, allocate(9), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_atom(open_file_stack,0), put_variable(y(4),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(4),0), get_list(0), unify_variable(x(0)), unify_void(1), get_structure((*)/2,0), unify_void(1), unify_variable(y(5)), put_structure(singletons/1,1), unify_variable(y(7)), put_structure(read_term/3,0), unify_value(y(5)), unify_variable(y(6)), unify_list, unify_value(x(1)), unify_nil, put_structure(syntax_error/1,2), unify_variable(y(8)), put_structure(error/2,1), unify_value(x(2)), unify_void(1), put_atom(after_syn_error,2), put_atom(user,3), put_atom(any,4), put_integer(0,5), call('$catch'/6), put_value(y(8),0), put_value(y(6),1), put_value(y(5),2), put_value(y(4),3), put_value(y(7),4), put_value(y(0),5), put_value(y(1),6), put_value(y(2),7), call('$get_next_clause/3_$aux1'/8), cut(y(3)), deallocate, proceed]). predicate(user:'$get_next_clause/3_$aux1'/8,406,static,private,monofile,local,[ pragma_arity(9), get_current_choice(x(8)), try_me_else(1), allocate(13), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), get_variable(y(7),7), put_value(y(0),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(8)), put_variable(y(8),0), put_void(1), call(last_read_start_line_column/2), put_structure(expand_term/2,0), unify_local_value(y(1)), unify_variable(y(9)), put_structure(error/2,1), unify_local_value(y(0)), unify_void(1), put_structure(dcg_error/1,2), unify_local_value(y(0)), put_atom(user,3), put_atom(any,4), put_integer(0,5), call('$catch'/6), put_value(y(2),0), put_variable(y(10),1), put_variable(y(11),2), call(stream_line_column/3), put_value(y(11),0), put_variable(y(12),1), put_value(y(10),2), call('$get_next_clause/3_$aux2'/3), put_structure((+)/2,1), unify_local_value(y(3)), unify_structure((-)/2), unify_local_value(y(8)), unify_local_value(y(12)), put_atom(where,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(9),0), put_value(y(4),2), put_value(y(5),3), put_value(y(6),4), put_value(y(7),5), deallocate, execute(get_next_clause1/6), label(1), trust_me_else_fail, put_value(x(5),0), put_value(x(6),1), put_value(x(7),2), execute(get_next_clause/3)]). predicate(user:'$get_next_clause/3_$aux2'/3,406,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_integer(1,0), cut(x(3)), math_fast_load_value(x(2),0), call_c('Pl_Fct_Fast_Dec',[fast_call,x(0)],[x(0)]), get_value(x(1),0), proceed, label(1), trust_me_else_fail, get_value(x(2),1), proceed]). predicate(user:get_next_clause1/6,426,static,private,monofile,global,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(13), switch_on_term(3,4,fail,fail,1), label(1), switch_on_structure([((:-)/1,2)]), label(2), try(6), retry(8), retry(10), trust(12), label(3), try_me_else(5), label(4), allocate(3), get_atom(end_of_file,0), get_variable(y(0),3), get_variable(y(1),4), get_variable(y(2),5), call(close_last_prolog_file/0), put_atom(open_file_stack,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), deallocate, execute('$get_next_clause1/6_$aux1'/4), label(5), retry_me_else(7), label(6), allocate(3), get_variable(y(0),3), get_variable(y(1),4), get_variable(y(2),5), get_structure((:-)/1,0), unify_structure(if/1), unify_variable(x(0)), cut(x(6)), put_atom(if_stack,2), put_variable(x(1),3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), call('$get_next_clause1/6_$aux2'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(get_next_clause/3), label(7), retry_me_else(9), label(8), allocate(3), get_variable(y(0),3), get_variable(y(1),4), get_variable(y(2),5), get_structure((:-)/1,0), unify_structure(elif/1), unify_variable(x(0)), cut(x(6)), call('$get_next_clause1/6_$aux3'/1), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(get_next_clause/3), label(9), retry_me_else(11), label(10), allocate(3), get_structure((:-)/1,0), unify_atom(else), get_variable(y(0),3), get_variable(y(1),4), get_variable(y(2),5), cut(x(6)), call('$get_next_clause1/6_$aux4'/0), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(get_next_clause/3), label(11), trust_me_else_fail, label(12), allocate(3), get_structure((:-)/1,0), unify_atom(endif), get_variable(y(0),3), get_variable(y(1),4), get_variable(y(2),5), cut(x(6)), call('$get_next_clause1/6_$aux5'/0), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(get_next_clause/3), label(13), retry_me_else(14), put_atom(if_stack,1), put_structure(if/2,7), unify_void(1), unify_variable(x(0)), put_list(2), unify_value(x(7)), unify_void(1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_integer(1,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(x(6)), put_value(x(3),0), put_value(x(4),1), put_value(x(5),2), execute(get_next_clause/3), label(14), retry_me_else(15), allocate(6), get_structure((:-)/1,0), unify_variable(y(0)), get_variable(y(1),1), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_variable(y(5),6), put_value(x(2),0), put_atom(directive,1), call(display_singletons/2), put_value(y(0),0), call('$get_next_clause1/6_$aux6'/1), put_value(y(0),0), put_value(y(1),1), call('$get_next_clause1/6_$aux7'/2), cut(y(5)), put_value(y(2),0), put_value(y(3),1), put_value(y(4),2), deallocate, execute(get_next_clause/3), label(15), retry_me_else(16), allocate(4), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), get_structure((+)/2,5), unify_local_value(x(1)), unify_local_value(x(0)), put_atom(foreign_only,1), put_atom(f,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), cut(x(6)), put_variable(y(3),1), call('$get_next_clause1/6_$aux8'/2), put_value(y(3),0), call('$get_next_clause1/6_$aux9'/1), put_value(y(3),0), call('$get_next_clause1/6_$aux10'/1), put_value(y(3),0), put_value(y(1),1), put_value(y(2),2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_value(y(3),0), call(check_head_is_module_free/1), put_value(y(1),0), put_value(y(2),1), call(check_module_clash/2), put_value(y(1),0), put_value(y(2),1), call(check_predicate/2), put_value(y(0),0), put_structure((/)/2,1), unify_local_value(y(1)), unify_local_value(y(2)), deallocate, execute(display_singletons/2), label(16), trust_me_else_fail, put_value(x(3),0), put_value(x(4),1), put_value(x(5),2), execute(get_next_clause/3)]). predicate(user:'$get_next_clause1/6_$aux10'/1,506,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('head is not a callable (~q)',0), execute(error/2)]). predicate(user:'$get_next_clause1/6_$aux9'/1,506,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_atom('head is a variable',0), put_nil(1), execute(error/2)]). predicate(user:'$get_next_clause1/6_$aux8'/2,506,static,private,monofile,local,[ try_me_else(1), get_structure((:-)/2,0), unify_local_value(x(1)), unify_void(1), proceed, label(1), trust_me_else_fail, get_value(x(1),0), proceed]). predicate(user:'$get_next_clause1/6_$aux7'/2,496,static,private,monofile,local,[ try_me_else(1), execute(handle_directive/2), label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('invalid directive ~q',0), execute(error/2)]). predicate(user:'$get_next_clause1/6_$aux6'/1,496,static,private,monofile,local,[ try_me_else(1), put_atom(foreign_only,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom(foreign,1), put_void(2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), proceed]). predicate(user:'$get_next_clause1/6_$aux5'/0,482,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), put_atom(if_stack,2), put_structure(if/2,1), unify_void(2), put_list(3), unify_value(x(1)), unify_variable(x(1)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), cut(x(0)), put_atom(if_stack,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom('unexpected endif directive',0), put_nil(1), execute(error/2)]). predicate(user:'$get_next_clause1/6_$aux4'/0,471,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), put_atom(if_stack,3), put_structure(if/2,2), unify_atom(then), unify_variable(x(1)), put_list(4), unify_value(x(2)), unify_variable(x(2)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(3),x(4)]), cut(x(0)), put_integer(1,0), math_fast_load_value(x(1),1), call_c('Pl_Fct_Fast_Sub',[fast_call,x(1)],[x(0),x(1)]), put_atom(if_stack,0), put_structure(if/2,3), unify_atom(else), unify_local_value(x(1)), put_list(1), unify_value(x(3)), unify_value(x(2)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom('unexpected else directive',0), put_nil(1), execute(error/2)]). predicate(user:'$get_next_clause1/6_$aux3'/1,454,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_variable(x(3),0), put_atom(if_stack,4), put_structure(if/2,2), unify_atom(then), unify_variable(x(0)), put_list(5), unify_value(x(2)), unify_variable(x(2)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(5)]), cut(x(1)), put_value(x(3),1), execute('$get_next_clause1/6_$aux11'/3), label(1), trust_me_else_fail, put_atom('unexpected elif directive',0), put_nil(1), execute(error/2)]). predicate(user:'$get_next_clause1/6_$aux11'/3,454,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_integer(0,0), cut(x(3)), put_value(x(1),0), put_value(x(2),1), execute('$get_next_clause1/6_$aux12'/2), label(1), trust_me_else_fail, put_atom(if_stack,0), put_structure(if/2,3), unify_atom(then), unify_integer(2), put_list(1), unify_value(x(3)), unify_local_value(x(2)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed]). predicate(user:'$get_next_clause1/6_$aux12'/2,454,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_structure(warn/2,3), unify_atom('elif directive caused exception: ~w'), unify_list, unify_variable(x(1)), unify_nil, put_structure((',')/2,2), unify_value(x(3)), unify_atom(fail), put_atom(user,3), put_atom(any,4), put_integer(0,5), call('$catch'/6), cut(y(1)), put_atom(if_stack,0), put_structure(if/2,2), unify_atom(then), unify_integer(1), put_list(1), unify_value(x(2)), unify_local_value(y(0)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(1), trust_me_else_fail, put_atom(if_stack,0), put_structure(if/2,3), unify_atom(then), unify_integer(0), put_list(2), unify_value(x(3)), unify_local_value(x(1)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(2)]), proceed]). predicate(user:'$get_next_clause1/6_$aux2'/2,444,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_structure(warn/2,3), unify_atom('if directive caused exception: ~w'), unify_list, unify_variable(x(1)), unify_nil, put_structure((',')/2,2), unify_value(x(3)), unify_atom(fail), put_atom(user,3), put_atom(any,4), put_integer(0,5), call('$catch'/6), cut(y(1)), put_atom(if_stack,0), put_structure(if/2,2), unify_atom(then), unify_integer(1), put_list(1), unify_value(x(2)), unify_local_value(y(0)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(1), trust_me_else_fail, put_atom(if_stack,0), put_structure(if/2,3), unify_atom(then), unify_integer(0), put_list(2), unify_value(x(3)), unify_local_value(x(1)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(2)]), proceed]). predicate(user:'$get_next_clause1/6_$aux1'/4,426,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_nil(0), cut(x(4)), get_atom(end_of_file,1), get_integer(0,2), get_structure((+)/2,3), unify_void(1), unify_atom(end_of_file), put_atom(eof_reached,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), execute('$get_next_clause1/6_$aux13'/0), label(1), trust_me_else_fail, put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), execute(get_next_clause/3)]). predicate(user:'$get_next_clause1/6_$aux13'/0,426,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), put_atom(if_stack,1), put_nil(2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), cut(x(0)), proceed, label(1), trust_me_else_fail, put_atom('endif directive expected',0), put_nil(1), execute(error/2)]). predicate(user:after_syn_error/0,532,static,private,monofile,global,[ allocate(3), put_atom(syn_error_nb,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), math_fast_load_value(x(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(1)],[x(0)]), put_atom(syn_error_nb,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_void(0), put_variable(y(0),1), put_variable(y(1),2), put_variable(y(2),3), call(syntax_error_info/4), put_atom(open_file_stack,0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(where,0), put_structure((+)/2,1), unify_value(x(2)), unify_structure((-)/2), unify_local_value(y(0)), unify_local_value(y(0)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('syntax error',0), put_unsafe_value(y(1),1), put_atom('~a',2), put_list(3), unify_local_value(y(2)), unify_nil, deallocate, execute(disp_msg/4)]). predicate(user:dcg_error/1,544,static,private,monofile,global,[ allocate(2), get_variable(y(0),0), put_variable(y(1),0), put_void(1), call(last_read_start_line_column/2), put_atom(open_file_stack,0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(where,0), put_structure((+)/2,1), unify_value(x(2)), unify_structure((-)/2), unify_local_value(y(1)), unify_local_value(y(1)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('DCG error raised: ~w',0), put_list(1), unify_local_value(y(0)), unify_nil, deallocate, execute(error/2)]). predicate(user:display_singletons/2,553,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_variable(y(0),1), put_atom(singl_warn,1), put_atom(t,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(3)]), cut(x(2)), put_variable(y(1),1), call(get_singletons/2), put_unsafe_value(y(1),0), put_value(y(0),1), deallocate, execute('$display_singletons/2_$aux1'/2), label(1), trust_me_else_fail, proceed]). predicate(user:'$display_singletons/2_$aux1'/2,553,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_nil(0), cut(x(2)), proceed, label(1), trust_me_else_fail, get_variable(x(2),1), put_list(1), unify_local_value(x(0)), unify_list, unify_local_value(x(2)), unify_nil, put_atom('singleton variables ~w for ~q',0), execute(warn/2)]). predicate(user:get_singletons/2,566,static,private,monofile,global,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure((=)/2,0), unify_variable(x(0)), unify_void(1), put_variable(y(1),2), call('$get_singletons/2_$aux1'/3), put_value(y(0),0), put_unsafe_value(y(1),1), deallocate, execute(get_singletons/2)]). predicate(user:'$get_singletons/2_$aux1'/3,568,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(3), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_integer(0,1), put_integer(1,2), put_void(3), put_atom('_',4), call(sub_atom/5), cut(y(2)), put_value(y(0),0), get_value(y(1),0), deallocate, proceed, label(1), trust_me_else_fail, get_list(1), unify_local_value(x(0)), unify_local_value(x(2)), proceed]). predicate(user:handle_directive/2,580,static,private,monofile,global,[ get_variable(x(2),1), get_variable(x(3),0), put_list(4), unify_variable(x(0)), unify_variable(x(1)), call_c('Pl_Blt_Univ',[fast_call,boolean],[x(3),x(4)]), execute(handle_directive/3)]). predicate(user:foreign_get_options/1,738,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call(foreign_get_options1/1), cut(y(1)), put_value(y(0),0), deallocate, execute(foreign_get_options/1)]). predicate(user:foreign_get_options1/1,745,static,private,monofile,global,[ switch_on_term(3,fail,fail,fail,1), label(1), switch_on_structure([(fct_name/1,4),(return/1,6),(bip_name/1,2),(bip_name/2,10),(choice_size/1,14)]), label(2), try(8), trust(12), label(3), try_me_else(5), label(4), get_structure(fct_name/1,0), unify_variable(x(1)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(1)]), put_atom(foreign_fct_name,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(5), retry_me_else(7), label(6), allocate(1), get_structure(return/1,0), unify_variable(y(0)), put_value(y(0),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), put_value(y(0),0), call('$foreign_get_options1/1_$aux1'/1), put_atom(foreign_return,0), put_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(7), retry_me_else(9), label(8), get_structure(bip_name/1,0), unify_variable(x(0)), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), get_atom(none,0), put_atom(foreign_bip,0), put_structure((/)/2,1), unify_atom(''), unify_integer(-1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(9), retry_me_else(11), label(10), get_structure(bip_name/2,0), unify_variable(x(3)), unify_variable(x(2)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(3)]), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(2)]), put_atom(foreign_bip,0), put_structure((/)/2,1), unify_value(x(3)), unify_value(x(2)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(11), retry_me_else(13), label(12), get_structure(bip_name/1,0), unify_structure((/)/2), unify_variable(x(3)), unify_variable(x(2)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(3)]), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(2)]), put_atom(foreign_bip,0), put_structure((/)/2,1), unify_value(x(3)), unify_value(x(2)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(13), trust_me_else_fail, label(14), get_structure(choice_size/1,0), unify_variable(x(1)), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(1)]), put_atom(foreign_choice_size,0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed]). predicate(user:'$foreign_get_options1/1_$aux1'/1,749,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(none,3),(boolean,5),(jump,7)]), label(2), try_me_else(4), label(3), get_atom(none,0), proceed, label(4), retry_me_else(6), label(5), get_atom(boolean,0), proceed, label(6), trust_me_else_fail, label(7), get_atom(jump,0), proceed]). predicate(user:foreign_check_types/4,779,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_nil(3), get_value(x(1),0), cut(x(4)), proceed, label(1), trust_me_else_fail, allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_list(3), unify_variable(x(1)), unify_variable(y(3)), get_structure((',')/2,1), unify_variable(x(2)), unify_variable(y(2)), math_fast_load_value(x(0),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_variable(y(4),0), put_value(y(4),1), put_value(y(1),3), put_variable(x(0),4), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(1),x(3),x(4)]), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_value(y(2),1), call('$foreign_check_types/4_$aux1'/3), put_value(y(2),0), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_value(y(2),0), call(foreign_check_arg/1), put_unsafe_value(y(4),0), put_value(y(0),1), put_value(y(1),2), put_value(y(3),3), deallocate, execute(foreign_check_types/4)]). predicate(user:'$foreign_check_types/4_$aux1'/3,782,static,private,monofile,local,[ switch_on_term(2,9,fail,fail,1), label(1), switch_on_structure([((+)/1,3),((-)/1,5),((?)/1,7)]), label(2), try_me_else(4), label(3), get_structure((+)/1,0), unify_local_value(x(1)), get_atom(in,2), proceed, label(4), retry_me_else(6), label(5), get_structure((-)/1,0), unify_local_value(x(1)), get_atom(out,2), proceed, label(6), retry_me_else(8), label(7), get_structure((?)/1,0), unify_local_value(x(1)), get_atom(in_out,2), proceed, label(8), trust_me_else_fail, label(9), get_atom(term,0), get_atom(term,1), get_atom(in,2), proceed]). predicate(user:foreign_check_arg/1,800,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(integer,3),(positive,5),(float,7),(number,9),(atom,11),(boolean,13),(char,15),(in_char,17),(code,19),(in_code,21),(byte,23),(in_byte,25),(string,27),(chars,29),(codes,31),(term,33)]), label(2), try_me_else(4), label(3), get_atom(integer,0), proceed, label(4), retry_me_else(6), label(5), get_atom(positive,0), proceed, label(6), retry_me_else(8), label(7), get_atom(float,0), proceed, label(8), retry_me_else(10), label(9), get_atom(number,0), proceed, label(10), retry_me_else(12), label(11), get_atom(atom,0), proceed, label(12), retry_me_else(14), label(13), get_atom(boolean,0), proceed, label(14), retry_me_else(16), label(15), get_atom(char,0), proceed, label(16), retry_me_else(18), label(17), get_atom(in_char,0), proceed, label(18), retry_me_else(20), label(19), get_atom(code,0), proceed, label(20), retry_me_else(22), label(21), get_atom(in_code,0), proceed, label(22), retry_me_else(24), label(23), get_atom(byte,0), proceed, label(24), retry_me_else(26), label(25), get_atom(in_byte,0), proceed, label(26), retry_me_else(28), label(27), get_atom(string,0), proceed, label(28), retry_me_else(30), label(29), get_atom(chars,0), proceed, label(30), retry_me_else(32), label(31), get_atom(codes,0), proceed, label(32), trust_me_else_fail, label(33), get_atom(term,0), proceed]). predicate(user:handle_initialization/3,827,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(system,3),(user,5)]), label(2), try_me_else(4), label(3), get_atom(system,0), put_structure(buff_exe_system/1,0), unify_structure((+)/2), unify_local_value(x(2)), unify_local_value(x(1)), put_meta_term(user,0,0), execute(assertz/1), label(4), trust_me_else_fail, label(5), get_atom(user,0), put_structure(buff_exe_user/1,0), unify_structure((+)/2), unify_local_value(x(2)), unify_local_value(x(1)), put_meta_term(user,0,0), execute(assertz/1)]). predicate(user:exec_directive/1,836,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_variable(y(0),1), put_structure(exec_directive_exception/2,2), unify_local_value(x(0)), unify_variable(x(1)), put_atom(user,3), put_atom(any,4), put_integer(0,5), call('$catch'/6), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('directive failed (~q)',0), execute(warn/2)]). predicate(user:exec_directive_exception/2,842,static,private,monofile,global,[ get_variable(x(2),1), put_list(1), unify_local_value(x(0)), unify_list, unify_local_value(x(2)), unify_nil, put_atom('directive failed (~q) with exception (~q)',0), execute(warn/2)]). predicate(user:used_bips_via_call/0,847,static,private,monofile,global,[ allocate(0), put_void(0), put_void(1), put_void(2), call(op/3), put_void(0), put_void(1), call(char_conversion/2), put_void(0), put_void(1), call(set_prolog_flag/2), put_void(0), put_void(1), deallocate, execute(expand_term/2)]). predicate(user:add_empty_dyn/2,856,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(2,3,fail,5,1), label(1), switch_on_structure([((',')/2,7),((/)/2,9)]), label(2), try_me_else(4), label(3), get_nil(0), cut(x(2)), proceed, label(4), retry_me_else(6), label(5), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(2)), put_value(y(1),1), call(add_empty_dyn/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(add_empty_dyn/2), label(6), retry_me_else(8), label(7), allocate(2), get_variable(y(1),1), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(2)), put_value(y(1),1), call(add_empty_dyn/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(add_empty_dyn/2), label(8), trust_me_else_fail, label(9), get_variable(x(2),1), get_structure((/)/2,0), unify_variable(x(0)), unify_variable(x(1)), execute('$add_empty_dyn/2_$aux1'/3)]). predicate(user:'$add_empty_dyn/2_$aux1'/3,869,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),3), put_structure(empty_dyn_pred/3,2), unify_local_value(x(0)), unify_local_value(x(1)), unify_void(1), put_meta_term(user,2,0), put_void(1), call(clause/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_structure(empty_dyn_pred/3,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), put_meta_term(user,3,0), execute(assertz/1)]). predicate(user:add_ensure_linked/1,879,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(3,4,fail,6,1), label(1), switch_on_structure([((',')/2,8),((/)/2,2)]), label(2), try(10), trust(12), label(3), try_me_else(5), label(4), get_nil(0), cut(x(1)), proceed, label(5), retry_me_else(7), label(6), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(1)), call(add_ensure_linked/1), put_value(y(0),0), deallocate, execute(add_ensure_linked/1), label(7), retry_me_else(9), label(8), allocate(1), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(1)), call(add_ensure_linked/1), put_value(y(0),0), deallocate, execute(add_ensure_linked/1), label(9), retry_me_else(11), label(10), allocate(1), get_structure((/)/2,0), unify_variable(x(3)), unify_variable(x(2)), get_variable(y(0),1), put_structure(ensure_linked/2,0), unify_value(x(3)), unify_value(x(2)), put_meta_term(user,0,0), put_atom(true,1), call(clause/2), cut(y(0)), deallocate, proceed, label(11), trust_me_else_fail, label(12), get_structure((/)/2,0), unify_variable(x(2)), unify_variable(x(1)), put_structure(ensure_linked/2,0), unify_value(x(2)), unify_value(x(1)), put_meta_term(user,0,0), execute(assertz/1)]). predicate(user:add_module_export_info/1,901,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(3,4,fail,6,1), label(1), switch_on_structure([((',')/2,8),((/)/2,2)]), label(2), try(10), trust(12), label(3), try_me_else(5), label(4), get_nil(0), cut(x(1)), proceed, label(5), retry_me_else(7), label(6), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(1)), call(add_module_export_info/1), put_value(y(0),0), deallocate, execute(add_module_export_info/1), label(7), retry_me_else(9), label(8), allocate(1), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(1)), call(add_module_export_info/1), put_value(y(0),0), deallocate, execute(add_module_export_info/1), label(9), retry_me_else(11), label(10), allocate(1), get_structure((/)/2,0), unify_variable(x(3)), unify_variable(x(2)), get_variable(y(0),1), put_structure(module_export/2,0), unify_value(x(3)), unify_value(x(2)), put_meta_term(user,0,0), put_atom(true,1), call(clause/2), cut(y(0)), deallocate, proceed, label(11), trust_me_else_fail, label(12), allocate(2), get_structure((/)/2,0), unify_variable(y(0)), unify_variable(y(1)), put_structure(module_export/2,0), unify_value(y(0)), unify_value(y(1)), put_meta_term(user,0,0), call(assertz/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$add_module_export_info/1_$aux1'/2)]). predicate(user:'$add_module_export_info/1_$aux1'/2,917,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(def,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(2)), put_value(y(0),0), put_value(y(1),1), deallocate, execute(check_module_clash/2), label(1), trust_me_else_fail, proceed]). predicate(user:add_module_import_info/2,928,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(2,3,fail,5,1), label(1), switch_on_structure([((',')/2,7),((as)/2,9),((/)/2,11)]), label(2), try_me_else(4), label(3), get_nil(0), cut(x(2)), proceed, label(4), retry_me_else(6), label(5), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(2)), put_value(y(1),1), call(add_module_import_info/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(add_module_import_info/2), label(6), retry_me_else(8), label(7), allocate(2), get_variable(y(1),1), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(2)), put_value(y(1),1), call(add_module_import_info/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(add_module_import_info/2), label(8), retry_me_else(10), label(9), get_variable(x(4),1), get_structure((as)/2,0), unify_variable(x(1)), unify_variable(x(0)), get_structure((/)/2,1), unify_variable(x(3)), unify_variable(x(1)), cut(x(2)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), put_value(x(4),2), execute(add_module_import_info1/4), label(10), trust_me_else_fail, label(11), get_variable(x(2),1), get_structure((/)/2,0), unify_variable(x(0)), unify_variable(x(1)), put_value(x(0),3), execute(add_module_import_info1/4)]). predicate(user:add_module_import_info1/4,951,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),4), put_structure(module_import/4,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_variable(y(4)), unify_void(1), put_meta_term(user,0,0), put_atom(true,1), call(clause/2), cut(y(3)), put_value(y(2),0), put_value(y(4),1), put_value(y(0),2), put_value(y(1),3), deallocate, execute('$add_module_import_info1/4_$aux1'/4), label(1), trust_me_else_fail, allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_structure(module_import/4,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(x(2)), unify_local_value(x(3)), put_meta_term(user,0,0), call(assertz/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$add_module_import_info1/4_$aux2'/2)]). predicate(user:'$add_module_import_info1/4_$aux2'/2,959,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(def,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(2)), put_value(y(0),0), put_value(y(1),1), deallocate, execute(check_module_clash/2), label(1), trust_me_else_fail, proceed]). predicate(user:'$add_module_import_info1/4_$aux1'/4,951,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_value(x(1),0), cut(x(4)), proceed, label(1), trust_me_else_fail, get_variable(x(0),1), put_structure((/)/2,4), unify_local_value(x(2)), unify_local_value(x(3)), put_list(1), unify_value(x(4)), unify_list, unify_local_value(x(0)), unify_nil, put_atom('predicate ~w already imported from module ~w',0), execute(error/2)]). predicate(user:check_module_name_decl/2,970,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), put_atom(open_file_stack,1), put_structure((*)/2,3), unify_variable(x(0)), unify_void(1), put_list(2), unify_value(x(3)), unify_void(1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_void(1), put_value(y(0),2), put_void(3), call(decompose_file_name/4), put_value(y(0),0), put_value(y(1),1), deallocate, execute(check_module_name_decl/2), label(1), trust_me_else_fail, get_value(x(1),0), put_value(x(1),0), execute(check_module_name_syntax/1)]). predicate(user:check_module_name_use/2,984,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), get_structure(library/1,0), unify_variable(x(0)), cut(x(2)), execute(check_module_name_use/2), label(1), trust_me_else_fail, get_value(x(1),0), put_value(x(1),0), execute(check_module_name_syntax/1)]). predicate(user:check_module_name_qualif/1,997,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, execute(check_module_name_syntax/1)]). predicate(user:check_module_name_syntax/1,1008,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_variable(y(0),1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), put_structure(atom_property/2,1), unify_local_value(x(0)), unify_atom(needs_quotes), put_meta_term(user,1,0), call((\+)/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('invalid module name (~q) should be an atom = valid file name',0), execute(error/2)]). predicate(user:check_head_is_module_free/1,1018,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_structure((:)/2,0), unify_variable(x(3)), unify_variable(x(2)), cut(x(1)), put_structure((:)/2,0), unify_value(x(3)), unify_value(x(2)), put_list(1), unify_value(x(0)), unify_nil, put_atom('module qualification is not allowed for the head of a clause (~w)',0), execute(error/2), label(1), trust_me_else_fail, proceed]). predicate(user:check_module_clash/2,1027,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_structure(module_import/4,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_variable(y(3)), unify_void(1), put_meta_term(user,0,0), put_atom(true,1), call(clause/2), put_value(y(0),0), put_value(y(1),1), put_variable(y(4),2), call(get_module_of_pred/3), put_value(y(3),0), put_unsafe_value(y(4),1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(y(2)), put_atom('clash on ~q - defined in module ~q (here) and imported from ~w',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_list, unify_local_value(y(4)), unify_list, unify_value(y(3)), unify_nil, deallocate, execute(error/2), label(1), trust_me_else_fail, proceed]). predicate(user:get_owner_module/4,1039,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_value(y(0),3), get_variable(y(3),4), put_structure(module_export/2,0), unify_local_value(y(0)), unify_local_value(y(1)), put_meta_term(user,0,0), put_atom(true,1), call(clause/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), call(get_module_of_pred/3), put_value(y(2),0), put_atom(system,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(2),0), put_atom(user,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(y(3)), deallocate, proceed, label(1), retry_me_else(2), allocate(2), get_variable(y(0),2), get_variable(y(1),4), put_structure(module_import/4,2), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(y(0)), unify_local_value(x(3)), put_meta_term(user,2,0), put_atom(true,1), call(clause/2), put_value(y(0),0), put_atom(system,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_atom(user,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(y(1)), deallocate, proceed, label(2), trust_me_else_fail, get_value(x(3),0), proceed]). predicate(user:is_exported/2,1053,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), allocate(1), get_variable(y(0),2), put_structure(module_export/2,2), unify_local_value(x(0)), unify_local_value(x(1)), put_meta_term(user,2,0), put_atom(true,1), call(clause/2), cut(y(0)), deallocate, proceed]). predicate(user:get_module_of_pred/3,1059,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), put_value(y(0),0), call('$aux_name'/1), cut(y(2)), put_value(y(0),0), put_variable(y(3),1), put_variable(y(4),2), call('$father_of_aux_name'/3), put_unsafe_value(y(3),0), put_unsafe_value(y(4),1), put_value(y(1),2), deallocate, execute(get_module_of_pred/3), label(1), trust_me_else_fail, execute('$get_module_of_pred/3_$aux1'/3)]). predicate(user:'$get_module_of_pred/3_$aux1'/3,1064,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(x(2),1), get_variable(y(1),3), put_value(x(0),1), put_atom(bpl,0), call(test_pred_info/3), cut(y(1)), put_value(y(0),0), get_atom(system,0), deallocate, proceed, label(1), retry_me_else(2), allocate(2), get_variable(y(0),2), get_variable(x(2),1), get_variable(y(1),3), put_value(x(0),1), put_atom(bfd,0), call(test_pred_info/3), cut(y(1)), put_value(y(0),0), get_atom(system,0), deallocate, proceed, label(2), trust_me_else_fail, put_atom(module,0), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), proceed]). predicate(user:get_module_of_cur_pred/1,1076,static,private,monofile,global,[ allocate(3), get_variable(y(0),0), put_variable(y(1),0), put_variable(y(2),1), call(cur_pred/2), put_unsafe_value(y(1),0), put_unsafe_value(y(2),1), put_value(y(0),2), deallocate, execute(get_module_of_pred/3)]). predicate(user:load_module_interface/4,1083,static,private,monofile,global,[ allocate(7), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), put_value(y(2),1), call(check_module_name_use/2), put_value(y(0),0), put_value(y(2),1), put_variable(y(4),2), call('$load_module_interface/4_$aux1'/3), put_value(y(4),0), put_variable(y(5),1), call(prolog_file_name/2), put_structure(load_module_interface_err/2,2), unify_variable(x(1)), unify_local_value(y(0)), put_structure(load_module_interface1/3,0), unify_local_value(y(5)), unify_local_value(y(0)), unify_variable(y(6)), put_atom(user,3), put_atom(load_module_interface,4), put_integer(4,5), call('$catch'/6), put_value(y(1),0), put_value(y(0),1), put_value(y(6),2), put_value(y(3),3), deallocate, execute(load_module_interface_compute_import_lst/4)]). predicate(user:'$load_module_interface/4_$aux1'/3,1083,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_structure(library/1,0), unify_void(1), cut(x(3)), put_atom(home,0), put_variable(y(2),1), call(current_prolog_flag/2), put_value(y(2),0), put_atom('/library/',1), put_variable(y(3),2), call(atom_concat/3), put_unsafe_value(y(3),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(atom_concat/3), label(1), trust_me_else_fail, get_value(x(1),2), proceed]). predicate(user:load_module_interface1/3,1101,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_atom(read,1), put_variable(y(3),2), call(open/3), put_atom(loaded_export_list,0), put_atom('$$empty',1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), call(repeat/0), put_structure(read/2,0), unify_local_value(y(3)), unify_variable(y(4)), put_void(1), put_atom(fail,2), put_atom(user,3), put_atom(load_module_interface1,4), put_integer(3,5), call('$catch'/6), put_value(y(4),0), put_value(y(2),1), put_value(y(1),2), put_value(y(0),3), call('$load_module_interface1/3_$aux1'/4), put_value(y(3),0), call(close/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$load_module_interface1/3_$aux2'/2)]). predicate(user:'$load_module_interface1/3_$aux2'/2,1101,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),1), put_atom(loaded_export_list,1), put_atom('$$empty',3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(3)]), cut(x(2)), put_list(1), unify_local_value(x(0)), unify_nil, put_atom('no module directive found in ~w (still imported)',0), call(warn/2), put_value(y(0),0), get_nil(0), deallocate, proceed, label(1), trust_me_else_fail, put_atom(loaded_export_list,0), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(user:'$load_module_interface1/3_$aux1'/4,1101,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), switch_on_term(1,2,fail,fail,4), label(1), try_me_else(3), label(2), get_atom(end_of_file,0), cut(x(4)), cut(x(1)), proceed, label(3), trust_me_else_fail, label(4), allocate(0), get_structure((:-)/1,0), unify_variable(x(0)), put_value(x(2),1), put_value(x(3),2), call('$load_module_interface1/3_$aux3'/3), fail]). predicate(user:'$load_module_interface1/3_$aux3'/3,1101,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), put_atom(module,5), put_variable(x(4),6), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(5),x(6)]), math_fast_load_value(x(4),5), put_integer(2,6), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(5),x(6)]), math_fast_load_value(x(4),4), put_integer(3,5), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), put_integer(2,3), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(3),x(0),x(1)]), put_value(x(1),0), put_value(x(2),1), execute('$load_module_interface1/3_$aux4'/2), label(1), trust_me_else_fail, get_structure((meta_predicate)/1,0), unify_variable(x(0)), put_value(x(2),1), execute('$load_module_interface1/3_$aux5'/2)]). predicate(user:'$load_module_interface1/3_$aux5'/2,1101,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(2)), put_variable(x(3),1), put_variable(x(2),4), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(4)]), put_structure(meta_pred/3,1), unify_value(x(3)), unify_value(x(2)), unify_local_value(x(0)), put_meta_term(user,1,0), execute(assertz/1), label(1), trust_me_else_fail, get_variable(x(2),1), put_list(1), unify_local_value(x(2)), unify_list, unify_local_value(x(0)), unify_nil, put_atom('reading interface of ~w: invalid directive meta_predicate/1 ~w (ignored)',0), execute(warn/2)]). predicate(user:'$load_module_interface1/3_$aux4'/2,1101,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(loaded_export_list,1), put_atom('$$empty',3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(3)]), cut(x(2)), put_atom(loaded_export_list,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(0)]), proceed, label(1), trust_me_else_fail, get_variable(x(0),1), put_list(1), unify_local_value(x(0)), unify_nil, put_atom('reading interface of ~w: more than one module directive - keep first',0), execute(warn/2)]). predicate(user:load_module_interface_err/2,1143,static,private,monofile,global,[ try_me_else(1), get_structure(error/2,0), unify_variable(x(0)), unify_void(1), get_structure(existence_error/2,0), unify_atom(source_sink), unify_void(1), get_variable(x(0),1), put_list(1), unify_local_value(x(0)), unify_nil, put_atom('cannot open ~w - does not exist (still imported)',0), execute(warn/2), label(1), trust_me_else_fail, get_variable(x(2),1), put_list(1), unify_local_value(x(2)), unify_list, unify_local_value(x(0)), unify_nil, put_atom('reading interface of ~w raised an error ~w (ignored)',0), execute(warn/2)]). predicate(user:load_module_interface_compute_import_lst/4,1152,static,private,monofile,global,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(5), switch_on_term(1,2,fail,fail,4), label(1), try_me_else(3), label(2), get_atom(all,0), get_value(x(3),2), cut(x(4)), proceed, label(3), trust_me_else_fail, label(4), get_structure(except/1,0), unify_variable(x(1)), cut(x(4)), put_value(x(2),0), put_value(x(3),2), execute(subtract/3), label(5), retry_me_else(6), allocate(4), get_variable(y(0),1), get_variable(y(1),2), put_value(x(0),1), put_variable(y(2),0), call(member/2), put_value(y(2),0), put_variable(y(3),1), call('$load_module_interface_compute_import_lst/4_$aux1'/2), put_value(y(3),0), put_value(y(1),1), put_value(y(0),2), call('$load_module_interface_compute_import_lst/4_$aux2'/3), fail, label(6), trust_me_else_fail, get_value(x(3),0), proceed]). predicate(user:'$load_module_interface_compute_import_lst/4_$aux2'/3,1159,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),3), call(memberchk/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_list, unify_local_value(x(2)), unify_nil, put_atom('~w is not currently exported by ~w (still imported)',0), execute(warn/2)]). predicate(user:'$load_module_interface_compute_import_lst/4_$aux1'/2,1159,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_structure((as)/2,0), unify_local_value(x(1)), unify_void(1), cut(x(2)), proceed, label(1), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(user:set_flag_for_preds/2,1178,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(2,3,fail,5,1), label(1), switch_on_structure([((',')/2,7),((/)/2,9)]), label(2), try_me_else(4), label(3), get_nil(0), cut(x(2)), proceed, label(4), retry_me_else(6), label(5), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(2)), put_value(y(1),1), call(set_flag_for_preds/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(set_flag_for_preds/2), label(6), retry_me_else(8), label(7), allocate(2), get_variable(y(1),1), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(2)), put_value(y(1),1), call(set_flag_for_preds/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(set_flag_for_preds/2), label(8), trust_me_else_fail, label(9), get_variable(x(4),1), get_structure((/)/2,0), unify_variable(x(0)), unify_variable(x(1)), get_variable(x(3),2), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(1)]), put_value(x(4),2), execute('$set_flag_for_preds/2_$aux1'/4)]). predicate(user:'$set_flag_for_preds/2_$aux1'/4,1191,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),4), put_atom(def,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(2)), put_atom('directive occurs after definition of ~q - directive ignored',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(warn/2), label(1), trust_me_else_fail, allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(2),0), put_value(y(0),1), put_value(y(1),2), call('$set_flag_for_preds/2_$aux2'/3), cut(y(3)), put_value(y(2),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(set_pred_info/3)]). predicate(user:'$set_flag_for_preds/2_$aux2'/3,1191,static,private,monofile,local,[ try_me_else(6), switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(bpl,3),(bfd,5)]), label(2), try_me_else(4), label(3), get_atom(bpl,0), put_atom(bfd,0), execute(unset_pred_info/3), label(4), trust_me_else_fail, label(5), get_atom(bfd,0), put_atom(bpl,0), execute(unset_pred_info/3), label(6), trust_me_else_fail, proceed]). predicate(user:define_predicate/2,1208,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(def,0), put_value(y(0),1), put_value(y(1),2), call(set_pred_info/3), put_atom(bpl,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(2)), deallocate, proceed, label(1), retry_me_else(2), allocate(1), get_variable(x(3),1), get_variable(y(0),2), put_value(x(0),1), put_value(x(3),2), put_atom(bfd,0), call(test_pred_info/3), cut(y(0)), deallocate, proceed, label(2), retry_me_else(3), get_variable(x(3),1), put_atom(default_kind,1), put_atom(built_in,4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(4)]), cut(x(2)), put_value(x(0),1), put_value(x(3),2), put_atom(bpl,0), execute(set_pred_info/3), label(3), retry_me_else(4), get_variable(x(3),1), put_atom(default_kind,1), put_atom(built_in_fd,4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(4)]), cut(x(2)), put_value(x(0),1), put_value(x(3),2), put_atom(bfd,0), execute(set_pred_info/3), label(4), trust_me_else_fail, proceed]). predicate(user:flag_bit/2,1228,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(def,3),(dyn,5),(pub,7),(bpl,9),(bfd,11),(discontig,13),(cut,15),(meta,17),(multi,19)]), label(2), try_me_else(4), label(3), get_atom(def,0), get_integer(0,1), proceed, label(4), retry_me_else(6), label(5), get_atom(dyn,0), get_integer(1,1), proceed, label(6), retry_me_else(8), label(7), get_atom(pub,0), get_integer(2,1), proceed, label(8), retry_me_else(10), label(9), get_atom(bpl,0), get_integer(3,1), proceed, label(10), retry_me_else(12), label(11), get_atom(bfd,0), get_integer(4,1), proceed, label(12), retry_me_else(14), label(13), get_atom(discontig,0), get_integer(5,1), proceed, label(14), retry_me_else(16), label(15), get_atom(cut,0), get_integer(6,1), proceed, label(16), retry_me_else(18), label(17), get_atom(meta,0), get_integer(7,1), proceed, label(18), trust_me_else_fail, label(19), get_atom(multi,0), get_integer(8,1), proceed]). predicate(user:set_pred_info/3,1241,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_variable(y(3),1), call(flag_bit/2), put_value(y(0),0), put_value(y(1),1), put_variable(y(4),2), call('$set_pred_info/3_$aux1'/3), cut(y(2)), math_fast_load_value(y(4),0), put_integer(1,1), math_fast_load_value(y(3),2), call_c('Pl_Fct_Fast_Shl',[fast_call,x(1)],[x(1),x(2)]), call_c('Pl_Fct_Fast_Or',[fast_call,x(1)],[x(0),x(1)]), put_structure(pred_info/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(x(1)), put_meta_term(user,0,0), deallocate, execute(assertz/1)]). predicate(user:'$set_pred_info/3_$aux1'/3,1241,static,private,monofile,local,[ try_me_else(1), put_structure(pred_info/3,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), put_meta_term(user,3,0), execute(retract/1), label(1), trust_me_else_fail, get_integer(0,2), proceed]). predicate(user:unset_pred_info/3,1252,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_variable(y(3),1), call(flag_bit/2), put_structure(pred_info/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_variable(y(4)), put_meta_term(user,0,0), call(retract/1), cut(y(2)), math_fast_load_value(y(4),0), put_integer(1,1), math_fast_load_value(y(3),2), call_c('Pl_Fct_Fast_Shl',[fast_call,x(1)],[x(1),x(2)]), call_c('Pl_Fct_Fast_Not',[fast_call,x(1)],[x(1)]), call_c('Pl_Fct_Fast_And',[fast_call,x(1)],[x(0),x(1)]), put_structure(pred_info/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(x(1)), put_meta_term(user,0,0), deallocate, execute(assertz/1), label(1), trust_me_else_fail, proceed]). predicate(user:test_pred_info/3,1263,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_variable(y(3),1), call(flag_bit/2), put_structure(pred_info/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_variable(y(4)), put_meta_term(user,0,0), put_void(1), call(clause/2), math_fast_load_value(y(4),0), put_integer(1,1), math_fast_load_value(y(3),2), call_c('Pl_Fct_Fast_Shl',[fast_call,x(1)],[x(1),x(2)]), call_c('Pl_Fct_Fast_And',[fast_call,x(0)],[x(0),x(1)]), put_integer(0,1), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(1)]), cut(y(2)), deallocate, proceed, label(1), trust_me_else_fail, get_atom(bpl,0), put_atom(module,0), put_atom(system,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(3)]), put_value(x(1),0), put_value(x(2),1), execute(is_exported/2)]). predicate(user:check_predicate/2,1275,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(redef_error,0), put_atom(t,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), call(control_construct/2), cut(y(2)), put_atom('redefining control construct ~q',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(error/2), label(1), retry_me_else(2), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(redef_error,0), put_atom(t,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), call(bip/2), cut(y(2)), put_atom('redefining built-in predicate ~q',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(error/2), label(2), retry_me_else(3), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(susp_warn,0), put_atom(t,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), call(suspicious_predicate/2), cut(y(2)), put_atom('suspicious predicate ~q',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(warn/2), label(3), retry_me_else(4), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(0),0), call('$aux_name'/1), cut(y(2)), put_atom('using system auxiliary predicate ~q',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(warn/2), label(4), trust_me_else_fail, proceed]). predicate(user:bip/2,1298,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), allocate(1), get_variable(y(0),2), put_atom(built_in,2), call('$predicate_property1'/3), cut(y(0)), deallocate, proceed]). predicate(user:control_construct/2,1306,static,private,monofile,global,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([((','),3),((;),5),((->),7),(!,9),(fail,11),(true,13),(call,15),(catch,17),(throw,19)]), label(2), try_me_else(4), label(3), get_atom(',',0), get_integer(2,1), proceed, label(4), retry_me_else(6), label(5), get_atom(;,0), get_integer(2,1), proceed, label(6), retry_me_else(8), label(7), get_atom(->,0), get_integer(2,1), proceed, label(8), retry_me_else(10), label(9), get_atom(!,0), get_integer(0,1), proceed, label(10), retry_me_else(12), label(11), get_atom(fail,0), get_integer(0,1), proceed, label(12), retry_me_else(14), label(13), get_atom(true,0), get_integer(0,1), proceed, label(14), retry_me_else(16), label(15), get_atom(call,0), get_integer(1,1), proceed, label(16), retry_me_else(18), label(17), get_atom(catch,0), get_integer(3,1), proceed, label(18), trust_me_else_fail, label(19), get_atom(throw,0), get_integer(1,1), proceed]). predicate(user:suspicious_predicate/2,1320,static,private,monofile,global,[ switch_on_term(3,1,fail,fail,fail), label(1), switch_on_atom([((:),4),((:-),2),((-->),10),({},12),((+),14),((-),16),((*),18),((/),20),((//),22)]), label(2), try(6), trust(8), label(3), try_me_else(5), label(4), get_atom(:,0), get_integer(2,1), proceed, label(5), retry_me_else(7), label(6), get_atom(:-,0), get_integer(1,1), proceed, label(7), retry_me_else(9), label(8), get_atom(:-,0), get_integer(2,1), proceed, label(9), retry_me_else(11), label(10), get_atom(-->,0), get_integer(2,1), proceed, label(11), retry_me_else(13), label(12), get_atom({},0), math_fast_load_value(x(1),0), put_integer(2,1), call_c('Pl_Blt_Fast_Lt',[fast_call,boolean],[x(0),x(1)]), proceed, label(13), retry_me_else(15), label(14), get_atom(+,0), get_integer(2,1), proceed, label(15), retry_me_else(17), label(16), get_atom(-,0), get_integer(2,1), proceed, label(17), retry_me_else(19), label(18), get_atom(*,0), get_integer(2,1), proceed, label(19), retry_me_else(21), label(20), get_atom(/,0), get_integer(2,1), proceed, label(21), trust_me_else_fail, label(22), get_atom(//,0), get_integer(2,1), proceed]). predicate(user:warn/2,1334,static,private,monofile,global,[ put_value(x(0),2), put_value(x(1),3), put_atom(warning,0), put_integer(0,1), execute(disp_msg/4)]). predicate(user:error/2,1340,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), allocate(1), get_variable(y(0),2), put_value(x(0),2), put_value(x(1),3), put_atom('fatal error',0), put_integer(0,1), call(disp_msg/4), call(repeat/0), put_value(y(0),0), call('$error/2_$aux1'/1), deallocate, execute(abort/0)]). predicate(user:'$error/2_$aux1'/1,1340,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_variable(y(0),1), call(close_last_prolog_file/0), cut(y(0)), fail, label(1), trust_me_else_fail, cut(x(0)), proceed]). predicate(user:disp_msg/4,1352,static,private,monofile,global,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(3),0), call(numbervars/1), put_atom(where,1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_value(y(1),1), call('$disp_msg/4_$aux1'/2), put_atom('~a: ',0), put_list(1), unify_local_value(y(0)), unify_nil, call(format/2), put_value(y(2),0), put_value(y(3),1), call(format/2), put_atom(user_output,0), deallocate, execute(nl/1)]). predicate(user:'$disp_msg/4_$aux1'/2,1352,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_variable(y(0),1), get_structure((+)/2,0), unify_variable(x(0)), unify_variable(y(1)), put_value(y(1),1), get_structure((-)/2,1), unify_void(2), cut(x(2)), put_void(1), call(disp_file_name/2), put_value(y(1),0), call(disp_lines/1), put_value(y(0),0), deallocate, execute(disp_column/1), label(1), trust_me_else_fail, proceed]). predicate(user:disp_file_name/2,1369,static,private,monofile,global,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_atom('',1), cut(x(2)), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_atom(' including ',1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_structure((*)/2,1), unify_variable(y(0)), unify_void(1), put_variable(y(1),1), call(disp_file_name/2), put_atom('~a~a',0), put_list(1), unify_local_value(y(1)), unify_list, unify_value(y(0)), unify_nil, deallocate, execute(format/2)]). predicate(user:disp_lines/1,1379,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(3,fail,fail,fail,1), label(1), switch_on_structure([((-)/2,2)]), label(2), try(4), trust(6), label(3), try_me_else(5), label(4), get_structure((-)/2,0), unify_variable(x(0)), unify_value(x(0)), cut(x(1)), put_list(1), unify_value(x(0)), unify_nil, put_atom(':~d',0), execute(format/2), label(5), trust_me_else_fail, label(6), get_structure((-)/2,0), unify_variable(x(2)), unify_variable(x(0)), put_list(1), unify_value(x(2)), unify_list, unify_value(x(0)), unify_nil, put_atom(':~d-~d',0), execute(format/2)]). predicate(user:disp_column/1,1388,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), math_fast_load_value(x(0),2), put_integer(0,3), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(2),x(3)]), cut(x(1)), put_list(1), unify_local_value(x(0)), unify_nil, put_atom(':~d: ',0), execute(format/2), label(1), trust_me_else_fail, put_atom(': ',0), execute(write/1)]). predicate(user:exception/1,1400,static,private,monofile,global,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(9), switch_on_term(3,fail,fail,fail,1), label(1), switch_on_structure([(error/2,2)]), label(2), try(4), retry(6), trust(8), label(3), try_me_else(5), label(4), allocate(3), get_structure(error/2,0), unify_variable(x(0)), unify_void(1), get_structure(syntax_error/1,0), unify_void(1), cut(x(1)), put_void(0), put_variable(y(0),1), put_variable(y(1),2), put_variable(y(2),3), call(syntax_error_info/4), put_atom(open_file_stack,0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(where,0), put_structure((+)/2,1), unify_value(x(2)), unify_structure((-)/2), unify_local_value(y(0)), unify_local_value(y(0)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('syntax error: ~a (char:~d)',0), put_list(1), unify_local_value(y(2)), unify_list, unify_local_value(y(1)), unify_nil, deallocate, execute(error/2), label(5), retry_me_else(7), label(6), get_structure(error/2,0), unify_variable(x(0)), unify_void(1), get_structure(existence_error/2,0), unify_atom(source_sink), unify_variable(x(0)), cut(x(1)), put_list(1), unify_value(x(0)), unify_nil, put_atom('cannot open file ~a - does not exist',0), execute(error/2), label(7), trust_me_else_fail, label(8), get_structure(error/2,0), unify_variable(x(0)), unify_void(1), get_structure(permission_error/3,0), unify_atom(open), unify_atom(source_sink), unify_variable(x(0)), cut(x(1)), put_list(1), unify_value(x(0)), unify_nil, put_atom('cannot open file ~a - permission error',0), execute(error/2), label(9), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('exception raised: ~q',0), execute(error/2)]). predicate(user:handle_directive/3,585,static,private,monofile,global,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(46), switch_on_term(4,1,fail,fail,fail), label(1), switch_on_atom([((public),5),((dynamic),7),((multifile),9),((discontiguous),11),(built_in,13),(built_in_fd,15),(ensure_linked,17),(encoding,19),(ensure_loaded,21),(include,23),(op,25),(char_conversion,27),(set_prolog_flag,29),((initialization),31),(module,33),(use_module,2),((meta_predicate),39),(foreign,3)]), label(2), try(35), trust(37), label(3), try(41), retry(43), trust(45), label(4), try_me_else(6), label(5), get_atom(public,0), cut(x(3)), put_nil(0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), put_value(x(1),0), put_atom(pub,1), execute(set_flag_for_preds/2), label(6), retry_me_else(8), label(7), allocate(2), get_atom(dynamic,0), get_variable(y(0),1), get_variable(y(1),2), cut(x(3)), put_value(y(0),0), put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_atom(dyn,1), call(set_flag_for_preds/2), put_value(y(0),0), put_atom(pub,1), call(set_flag_for_preds/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(add_empty_dyn/2), label(8), retry_me_else(10), label(9), allocate(2), get_atom(multifile,0), get_variable(y(0),1), get_variable(y(1),2), cut(x(3)), put_value(y(0),0), put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_atom(multi,1), call(set_flag_for_preds/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute(add_empty_dyn/2), label(10), retry_me_else(12), label(11), get_atom(discontiguous,0), cut(x(3)), put_nil(0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), put_value(x(1),0), put_atom(discontig,1), execute(set_flag_for_preds/2), label(12), retry_me_else(14), label(13), allocate(1), get_atom(built_in,0), get_variable(y(0),3), cut(y(0)), put_value(x(1),0), call('$handle_directive/3_$aux1'/1), cut(y(0)), deallocate, proceed, label(14), retry_me_else(16), label(15), get_atom(built_in_fd,0), cut(x(3)), put_value(x(1),0), execute('$handle_directive/3_$aux2'/1), label(16), retry_me_else(18), label(17), get_atom(ensure_linked,0), cut(x(3)), put_value(x(1),0), execute('$handle_directive/3_$aux3'/1), label(18), retry_me_else(20), label(19), get_atom(encoding,0), cut(x(3)), put_atom('encoding directive not supported - directive ignored',0), put_nil(1), execute(warn/2), label(20), retry_me_else(22), label(21), get_atom(ensure_loaded,0), cut(x(3)), put_atom('ensure_loaded directive not supported - directive ignored',0), put_nil(1), execute(warn/2), label(22), retry_me_else(24), label(23), get_atom(include,0), get_list(1), unify_variable(x(0)), unify_nil, cut(x(3)), execute(open_new_prolog_file/1), label(24), retry_me_else(26), label(25), allocate(4), get_atom(op,0), get_list(1), unify_variable(y(0)), unify_list, unify_variable(y(1)), unify_list, unify_variable(y(2)), unify_nil, get_variable(y(3),2), cut(x(3)), put_structure(op/3,0), unify_value(y(0)), unify_value(y(1)), unify_value(y(2)), call(exec_directive/1), put_atom(system,0), put_structure(op/3,1), unify_value(y(0)), unify_value(y(1)), unify_value(y(2)), put_value(y(3),2), deallocate, execute(handle_initialization/3), label(26), retry_me_else(28), label(27), allocate(3), get_atom(char_conversion,0), get_list(1), unify_variable(y(0)), unify_list, unify_variable(y(1)), unify_nil, get_variable(y(2),2), cut(x(3)), put_structure(char_conversion/2,0), unify_value(y(0)), unify_value(y(1)), call(exec_directive/1), put_atom(system,0), put_structure(char_conversion/2,1), unify_value(y(0)), unify_value(y(1)), put_value(y(2),2), deallocate, execute(handle_initialization/3), label(28), retry_me_else(30), label(29), allocate(3), get_atom(set_prolog_flag,0), get_list(1), unify_variable(y(0)), unify_list, unify_variable(y(1)), unify_nil, get_variable(y(2),2), cut(x(3)), put_structure(set_prolog_flag/2,0), unify_value(y(0)), unify_value(y(1)), call(exec_directive/1), call('$handle_directive/3_$aux4'/0), put_atom(system,0), put_structure(set_prolog_flag/2,1), unify_value(y(0)), unify_value(y(1)), put_value(y(2),2), deallocate, execute(handle_initialization/3), label(30), retry_me_else(32), label(31), get_atom(initialization,0), get_list(1), unify_variable(x(1)), unify_nil, cut(x(3)), put_atom(user,0), execute(handle_initialization/3), label(32), retry_me_else(34), label(33), get_atom(module,0), get_list(1), unify_variable(x(0)), unify_list, unify_variable(x(1)), unify_nil, cut(x(3)), execute('$handle_directive/3_$aux5'/2), label(34), retry_me_else(36), label(35), get_atom(use_module,0), get_list(1), unify_variable(x(0)), unify_nil, cut(x(3)), put_list(1), unify_value(x(0)), unify_list, unify_atom(all), unify_nil, put_atom(use_module,0), execute(handle_directive/3), label(36), retry_me_else(38), label(37), allocate(2), get_atom(use_module,0), get_list(1), unify_variable(x(0)), unify_list, unify_variable(x(1)), unify_nil, cut(x(3)), put_variable(y(0),2), put_variable(y(1),3), call(load_module_interface/4), put_unsafe_value(y(1),0), put_unsafe_value(y(0),1), deallocate, execute(add_module_import_info/2), label(38), retry_me_else(40), label(39), get_atom(meta_predicate,0), get_list(1), unify_variable(x(0)), unify_nil, cut(x(3)), put_value(x(2),1), execute('$handle_directive/3_$aux6'/2), label(40), retry_me_else(42), label(41), get_atom(foreign,0), get_list(1), unify_variable(x(0)), unify_nil, cut(x(3)), put_list(1), unify_value(x(0)), unify_list, unify_nil, unify_nil, put_atom(foreign,0), execute(handle_directive/3), label(42), retry_me_else(44), label(43), get_atom(foreign,0), put_atom(call_c,0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), cut(x(3)), put_atom('foreign directive ignored (not allowed in this mode)',0), put_nil(1), execute(warn/2), label(44), trust_me_else_fail, label(45), allocate(7), get_atom(foreign,0), get_list(1), unify_variable(y(0)), unify_list, unify_variable(y(1)), unify_nil, get_variable(y(2),2), cut(x(3)), put_value(y(0),0), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), put_value(y(1),0), call_c('Pl_Blt_List',[fast_call,boolean],[x(0)]), put_value(y(0),0), put_variable(y(3),1), put_variable(y(4),2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_value(y(3),0), put_value(y(4),1), call('$handle_directive/3_$aux7'/2), put_value(y(3),0), put_value(y(4),1), call(define_predicate/2), put_atom(foreign_fct_name,0), put_value(y(3),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(foreign_return,0), put_atom(boolean,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(foreign_bip,0), put_structure((/)/2,1), unify_local_value(y(3)), unify_local_value(y(4)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(foreign_choice_size,0), put_integer(-1,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(1),0), call(foreign_get_options/1), put_integer(0,0), put_value(y(4),1), put_value(y(0),2), put_variable(y(5),3), call(foreign_check_types/4), put_atom(foreign_fct_name,0), put_variable(x(4),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(foreign_return,0), put_variable(x(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(foreign_bip,0), put_variable(x(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(foreign_choice_size,0), put_variable(x(1),5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(5)]), put_structure(args/5,0), unify_value(x(4)), unify_value(x(3)), unify_value(x(2)), unify_value(x(1)), unify_local_value(y(5)), put_variable(y(6),1), call(no_internal_transf/2), put_variable(x(0),1), put_value(y(3),2), put_value(y(4),3), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(2),x(3)]), put_structure((+)/2,1), unify_local_value(y(2)), unify_structure((:-)/2), unify_value(x(0)), unify_structure('$foreign_call_c'/1), unify_local_value(y(6)), put_structure(buff_discontig_clause/3,0), unify_local_value(y(3)), unify_local_value(y(4)), unify_value(x(1)), put_meta_term(user,0,0), call(assertz/1), put_structure((/)/2,0), unify_atom('$force_foreign_link'), unify_integer(0), deallocate, execute(add_ensure_linked/1), label(46), trust_me_else_fail, allocate(2), get_variable(y(0),0), put_value(x(1),0), put_variable(y(1),1), call(length/2), put_atom('unknown directive ~q - maybe use initialization/1 - directive ignored',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(warn/2)]). predicate(user:'$handle_directive/3_$aux7'/2,709,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom(pub,0), put_value(y(0),1), put_value(y(1),2), call(test_pred_info/3), cut(y(2)), put_atom('foreign predicate ~q should not be public/dynamic',0), put_structure((/)/2,2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(1), unify_value(x(2)), unify_nil, deallocate, execute(error/2), label(1), trust_me_else_fail, proceed]). predicate(user:'$handle_directive/3_$aux6'/2,689,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(2)), put_value(y(0),0), put_variable(y(2),1), put_variable(y(3),2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_structure((/)/2,0), unify_local_value(y(2)), unify_local_value(y(3)), put_atom(meta,1), call(set_flag_for_preds/2), put_structure(meta_pred/3,0), unify_local_value(y(2)), unify_local_value(y(3)), unify_local_value(y(0)), put_meta_term(user,0,0), call(assertz/1), put_value(y(2),0), put_value(y(3),1), put_variable(y(4),2), call(get_module_of_pred/3), put_atom(system,0), put_structure('$declare_meta_predicate'/2,1), unify_local_value(y(4)), unify_local_value(y(0)), put_value(y(1),2), deallocate, execute(handle_initialization/3), label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('invalid directive meta_predicate/1 ~w',0), execute(error/2)]). predicate(user:'$handle_directive/3_$aux5'/2,668,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(2), get_variable(y(0),1), put_atom(module_already_seen,1), put_atom(f,3), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(3)]), cut(x(2)), put_variable(y(1),1), call(check_module_name_decl/2), put_atom(module_already_seen,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(module,0), put_unsafe_value(y(1),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), deallocate, execute(add_module_export_info/1), label(1), trust_me_else_fail, put_atom('directive module already declared',0), put_nil(1), execute(error/2)]). predicate(user:'$handle_directive/3_$aux4'/0,654,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), allocate(1), get_variable(y(0),0), put_atom(singleton_warning,0), put_atom(off,1), call(current_prolog_flag/2), cut(y(0)), put_atom(singl_warn,0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(1), trust_me_else_fail, put_atom(singl_warn,0), put_atom(t,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed]). predicate(user:'$handle_directive/3_$aux3'/1,624,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), put_atom(native_code,0), put_atom(f,2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), cut(x(1)), put_atom('ensure_linked directive ignored in byte-code compilation mode',0), put_nil(1), execute(warn/2), label(1), trust_me_else_fail, put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), execute(add_ensure_linked/1)]). predicate(user:'$handle_directive/3_$aux2'/1,616,static,private,monofile,local,[ try_me_else(1), put_nil(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), put_atom(default_kind,0), put_atom(built_in_fd,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom(bfd,1), execute(set_flag_for_preds/2)]). predicate(user:'$handle_directive/3_$aux1'/1,608,static,private,monofile,local,[ try_me_else(1), put_nil(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), put_atom(default_kind,0), put_atom(built_in,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom(bpl,1), execute(set_flag_for_preds/2)]). directive(127,system,[ put_integer(200,0), put_atom(fx,1), put_atom(?,2), execute(op/3)]). �������������������������������������������gprolog-1.4.5/src/config.sub������������������������������������������������������������������������0000755�0001750�0001750�00000105176�13021324543�014103� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, # 2011, 2012 Free Software Foundation, Inc. timestamp='2012-02-10' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software # can handle that machine. It does not imply ALL GNU software can. # # This file 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, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Please send patches to <config-patches@gnu.org>. Submit a context # diff and a properly formatted GNU ChangeLog entry. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. # You can get the latest version of this script from: # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. # Each package is responsible for reporting which valid configurations # it does not support. The user should be able to distinguish # a failure to support a valid configuration from a meaningless # configuration. # The goal of this file is to map all the various variations of a given # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or in some cases, the newer four-part form: # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] CPU-MFR-OPSYS $0 [OPTION] ALIAS Canonicalize a configuration name. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to <config-patches@gnu.org>." version="\ GNU config.sub ($timestamp) Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" exit 1 ;; *local*) # First pass through any local machine types. echo $1 exit ;; * ) break ;; esac done case $# in 0) echo "$me: missing argument$help" >&2 exit 1;; 1) ;; *) echo "$me: too many arguments$help" >&2 exit 1;; esac # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ knetbsd*-gnu* | netbsd*-gnu* | \ kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; android-linux) os=-linux-android basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] then os=`echo $1 | sed 's/.*-/-/'` else os=; fi ;; esac ### Let's recognize common machines as not being operating systems so ### that things like config.sub decstation-3100 work. We also ### recognize some manufacturers as not being operating systems, so we ### can provide default operating systems below. case $os in -sun*os*) # Prevent following clause from handling this invalid input. ;; -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ -apple | -axis | -knuth | -cray | -microblaze) os= basic_machine=$1 ;; -bluegene*) os=-cnk ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 ;; -scout) ;; -wrs) os=-vxworks basic_machine=$1 ;; -chorusos*) os=-chorusos basic_machine=$1 ;; -chorusrdb) os=-chorusrdb basic_machine=$1 ;; -hiux*) os=-hiuxwe2 ;; -sco6) os=-sco5v6 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco5v6*) # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -udk*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) basic_machine=clipper-intergraph ;; -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) os=-lynxos ;; -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; -windowsnt*) os=`echo $os | sed -e 's/windowsnt/winnt/'` ;; -psos*) os=-psos ;; -mint | -mint[0-9]*) basic_machine=m68k-atari os=-mint ;; esac # Decode aliases for certain CPU-COMPANY combinations. case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ | le32 | le64 \ | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ | maxq | mb | microblaze | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ | mips64r5900 | mips64r5900el \ | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ | moxie \ | mt \ | msp430 \ | nds32 | nds32le | nds32be \ | nios | nios2 \ | ns16k | ns32k \ | open8 \ | or32 \ | pdp10 | pdp11 | pj | pjl \ | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ | rl78 | rx \ | score \ | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ | spu \ | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ | ubicom32 \ | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ | x86 | xc16x | xstormy16 | xtensa \ | z8k | z80) basic_machine=$basic_machine-unknown ;; c54x) basic_machine=tic54x-unknown ;; c55x) basic_machine=tic55x-unknown ;; c6x) basic_machine=tic6x-unknown ;; m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; ms1) basic_machine=mt-unknown ;; strongarm | thumb | xscale) basic_machine=arm-unknown ;; xgate) basic_machine=$basic_machine-unknown os=-none ;; xscaleeb) basic_machine=armeb-unknown ;; xscaleel) basic_machine=armel-unknown ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. i*86 | x86_64) basic_machine=$basic_machine-pc ;; # Object if more than one company name word. *-*-*) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ | be32-* | be64-* \ | bfin-* | bs2000-* \ | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ | le32-* | le64-* \ | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ | mips64r5900-* | mips64r5900el-* \ | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ | nds32-* | nds32le-* | nds32be-* \ | nios-* | nios2-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ | rl78-* | romp-* | rs6000-* | rx-* \ | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ | tile*-* \ | tron-* \ | ubicom32-* \ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ | vax-* \ | we32k-* \ | x86-* | x86_64-* | xc16x-* | xps100-* \ | xstormy16-* | xtensa*-* \ | ymp-* \ | z8k-* | z80-*) ;; # Recognize the basic CPU types without company name, with glob match. xtensa*) basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. 386bsd) basic_machine=i386-unknown os=-bsd ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; a29khif) basic_machine=a29k-amd os=-udi ;; abacus) basic_machine=abacus-unknown ;; adobe68k) basic_machine=m68010-adobe os=-scout ;; alliant | fx80) basic_machine=fx80-alliant ;; altos | altos3068) basic_machine=m68k-altos ;; am29k) basic_machine=a29k-none os=-bsd ;; amd64) basic_machine=x86_64-pc ;; amd64-*) basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; amdahl) basic_machine=580-amdahl os=-sysv ;; amiga | amiga-*) basic_machine=m68k-unknown ;; amigaos | amigados) basic_machine=m68k-unknown os=-amigaos ;; amigaunix | amix) basic_machine=m68k-unknown os=-sysv4 ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; apollo68bsd) basic_machine=m68k-apollo os=-bsd ;; aros) basic_machine=i386-pc os=-aros ;; aux) basic_machine=m68k-apple os=-aux ;; balance) basic_machine=ns32k-sequent os=-dynix ;; blackfin) basic_machine=bfin-unknown os=-linux ;; blackfin-*) basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` os=-linux ;; bluegene*) basic_machine=powerpc-ibm os=-cnk ;; c54x-*) basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` ;; c55x-*) basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` ;; c6x-*) basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` ;; c90) basic_machine=c90-cray os=-unicos ;; cegcc) basic_machine=arm-unknown os=-cegcc ;; convex-c1) basic_machine=c1-convex os=-bsd ;; convex-c2) basic_machine=c2-convex os=-bsd ;; convex-c32) basic_machine=c32-convex os=-bsd ;; convex-c34) basic_machine=c34-convex os=-bsd ;; convex-c38) basic_machine=c38-convex os=-bsd ;; cray | j90) basic_machine=j90-cray os=-unicos ;; craynv) basic_machine=craynv-cray os=-unicosmp ;; cr16 | cr16-*) basic_machine=cr16-unknown os=-elf ;; crds | unos) basic_machine=m68k-crds ;; crisv32 | crisv32-* | etraxfs*) basic_machine=crisv32-axis ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; crx) basic_machine=crx-unknown os=-elf ;; da30 | da30-*) basic_machine=m68k-da30 ;; decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; decsystem10* | dec10*) basic_machine=pdp10-dec os=-tops10 ;; decsystem20* | dec20*) basic_machine=pdp10-dec os=-tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; dicos) basic_machine=i686-pc os=-dicos ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; es1800 | OSE68k | ose68k | ose | OSE) basic_machine=m68k-ericsson os=-ose ;; fx2800) basic_machine=i860-alliant ;; genix) basic_machine=ns32k-ns ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; go32) basic_machine=i386-pc os=-go32 ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; h8300xray) basic_machine=h8300-hitachi os=-xray ;; h8500hms) basic_machine=h8500-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; hp300-*) basic_machine=m68k-hp ;; hp300bsd) basic_machine=m68k-hp os=-bsd ;; hp300hpux) basic_machine=m68k-hp os=-hpux ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) basic_machine=m68000-hp ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) basic_machine=hppa1.0-hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) basic_machine=hppa1.1-hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp basic_machine=hppa1.1-hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) basic_machine=hppa1.1-hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) basic_machine=hppa1.0-hp ;; hppa-next) os=-nextstep3 ;; hppaosf) basic_machine=hppa1.1-hp os=-osf ;; hppro) basic_machine=hppa1.1-hp os=-proelf ;; i370-ibm* | ibm*) basic_machine=i370-ibm ;; i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i*86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i*86v) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i*86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; i386mach) basic_machine=i386-mach os=-mach ;; i386-vsta | vsta) basic_machine=i386-unknown os=-vsta ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; m68knommu) basic_machine=m68k-unknown os=-linux ;; m68knommu-*) basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` os=-linux ;; m88k-omron*) basic_machine=m88k-omron ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; merlin) basic_machine=ns32k-utek os=-sysv ;; microblaze) basic_machine=microblaze-xilinx ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; mingw32ce) basic_machine=arm-unknown os=-mingw32ce ;; miniframe) basic_machine=m68000-convergent ;; *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) basic_machine=m68k-atari os=-mint ;; mips3*-*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` ;; mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; monitor) basic_machine=m68k-rom68k os=-coff ;; morphos) basic_machine=powerpc-unknown os=-morphos ;; msdos) basic_machine=i386-pc os=-msdos ;; ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; msys) basic_machine=i386-pc os=-msys ;; mvs) basic_machine=i370-ibm os=-mvs ;; nacl) basic_machine=le32-unknown os=-nacl ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; netbsd386) basic_machine=i386-unknown os=-netbsd ;; netwinder) basic_machine=armv4l-rebel os=-linux ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; news1000) basic_machine=m68030-sony os=-newsos ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; necv70) basic_machine=v70-nec os=-sysv ;; next | m*-next ) basic_machine=m68k-next case $os in -nextstep* ) ;; -ns2*) os=-nextstep2 ;; *) os=-nextstep3 ;; esac ;; nh3000) basic_machine=m68k-harris os=-cxux ;; nh[45]000) basic_machine=m88k-harris os=-cxux ;; nindy960) basic_machine=i960-intel os=-nindy ;; mon960) basic_machine=i960-intel os=-mon960 ;; nonstopux) basic_machine=mips-compaq os=-nonstopux ;; np1) basic_machine=np1-gould ;; neo-tandem) basic_machine=neo-tandem ;; nse-tandem) basic_machine=nse-tandem ;; nsr-tandem) basic_machine=nsr-tandem ;; op50n-* | op60c-*) basic_machine=hppa1.1-oki os=-proelf ;; openrisc | openrisc-*) basic_machine=or32-unknown ;; os400) basic_machine=powerpc-ibm os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson os=-ose ;; os68k) basic_machine=m68k-none os=-os68k ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; paragon) basic_machine=i860-intel os=-osf ;; parisc) basic_machine=hppa-unknown os=-linux ;; parisc-*) basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` os=-linux ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; pc532 | pc532-*) basic_machine=ns32k-pc532 ;; pc98) basic_machine=i386-pc ;; pc98-*) basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; pentium4) basic_machine=i786-pc ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentium4-*) basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; ppc | ppcbe) basic_machine=powerpc-unknown ;; ppc-* | ppcbe-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown ;; ppcle-* | powerpclittle-*) basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64) basic_machine=powerpc64-unknown ;; ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppc64le | powerpc64little | ppc64-le | powerpc64-little) basic_machine=powerpc64le-unknown ;; ppc64le-* | powerpc64little-*) basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ps2) basic_machine=i386-ibm ;; pw32) basic_machine=i586-unknown os=-pw32 ;; rdos) basic_machine=i386-pc os=-rdos ;; rom68k) basic_machine=m68k-rom68k os=-coff ;; rm[46]00) basic_machine=mips-siemens ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; s390 | s390-*) basic_machine=s390-ibm ;; s390x | s390x-*) basic_machine=s390x-ibm ;; sa29200) basic_machine=a29k-amd os=-udi ;; sb1) basic_machine=mipsisa64sb1-unknown ;; sb1el) basic_machine=mipsisa64sb1el-unknown ;; sde) basic_machine=mipsisa32-sde os=-elf ;; sei) basic_machine=mips-sei os=-seiux ;; sequent) basic_machine=i386-sequent ;; sh) basic_machine=sh-hitachi os=-hms ;; sh5el) basic_machine=sh5le-unknown ;; sh64) basic_machine=sh64-unknown ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; spur) basic_machine=spur-unknown ;; st2000) basic_machine=m68k-tandem ;; stratus) basic_machine=i860-stratus os=-sysv4 ;; strongarm-* | thumb-*) basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` ;; sun2) basic_machine=m68000-sun ;; sun2os3) basic_machine=m68000-sun os=-sunos3 ;; sun2os4) basic_machine=m68000-sun os=-sunos4 ;; sun3os3) basic_machine=m68k-sun os=-sunos3 ;; sun3os4) basic_machine=m68k-sun os=-sunos4 ;; sun4os3) basic_machine=sparc-sun os=-sunos3 ;; sun4os4) basic_machine=sparc-sun os=-sunos4 ;; sun4sol2) basic_machine=sparc-sun os=-solaris2 ;; sun3 | sun3-*) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; sv1) basic_machine=sv1-cray os=-unicos ;; symmetry) basic_machine=i386-sequent os=-dynix ;; t3e) basic_machine=alphaev5-cray os=-unicos ;; t90) basic_machine=t90-cray os=-unicos ;; tile*) basic_machine=$basic_machine-unknown os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown ;; tx39el) basic_machine=mipstx39el-unknown ;; toad1) basic_machine=pdp10-xkl os=-tops20 ;; tower | tower-32) basic_machine=m68k-ncr ;; tpf) basic_machine=s390x-ibm os=-tpf ;; udi29k) basic_machine=a29k-amd os=-udi ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; v810 | necv810) basic_machine=v810-nec os=-none ;; vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; vpp*|vx|vx-*) basic_machine=f301-fujitsu ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; vxworks29k) basic_machine=a29k-wrs os=-vxworks ;; w65*) basic_machine=w65-wdc os=-none ;; w89k-*) basic_machine=hppa1.1-winbond os=-proelf ;; xbox) basic_machine=i686-pc os=-mingw32 ;; xps | xps100) basic_machine=xps100-honeywell ;; xscale-* | xscalee[bl]-*) basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` ;; ymp) basic_machine=ymp-cray os=-unicos ;; z8k-*-coff) basic_machine=z8k-unknown os=-sim ;; z80-*-coff) basic_machine=z80-unknown os=-sim ;; none) basic_machine=none-none os=-none ;; # Here we handle the default manufacturer of certain CPU types. It is in # some cases the only manufacturer, in others, it is the most popular. w89k) basic_machine=hppa1.1-winbond ;; op50n) basic_machine=hppa1.1-oki ;; op60c) basic_machine=hppa1.1-oki ;; romp) basic_machine=romp-ibm ;; mmix) basic_machine=mmix-knuth ;; rs6000) basic_machine=rs6000-ibm ;; vax) basic_machine=vax-dec ;; pdp10) # there are many clones, so DEC is not a safe bet basic_machine=pdp10-unknown ;; pdp11) basic_machine=pdp11-dec ;; we32k) basic_machine=we32k-att ;; sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) basic_machine=sparc-sun ;; cydra) basic_machine=cydra-cydrome ;; orion) basic_machine=orion-highlevel ;; orion105) basic_machine=clipper-highlevel ;; mac | mpw | mac-mpw) basic_machine=m68k-apple ;; pmac | pmac-mpw) basic_machine=powerpc-apple ;; *-unknown) # Make sure to match an already-canonicalized machine name. ;; *) echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 exit 1 ;; esac # Here we canonicalize certain aliases for manufacturers. case $basic_machine in *-digital*) basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` ;; *-commodore*) basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` ;; *) ;; esac # Decode manufacturer-specific aliases for certain operating systems. if [ x"$os" != x"" ] then case $os in # First match some system type aliases # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -auroraux) os=-auroraux ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; -solaris) os=-solaris2 ;; -svr4*) os=-sysv4 ;; -unixware*) os=-sysv4.2uw ;; -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. # The portable systems comes first. # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ | -sym* | -kopensolaris* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -chorusos* | -chorusrdb* | -cegcc* \ | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ | -mingw32* | -linux-gnu* | -linux-android* \ | -linux-newlib* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) case $basic_machine in x86-* | i*86-*) ;; *) os=-nto$os ;; esac ;; -nto-qnx*) ;; -nto*) os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; -linux-dietlibc) os=-linux-dietlibc ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` ;; -sunos6*) os=`echo $os | sed -e 's|sunos6|solaris3|'` ;; -opened*) os=-openedition ;; -os400*) os=-os400 ;; -wince*) os=-wince ;; -osfrose*) os=-osfrose ;; -osf*) os=-osf ;; -utek*) os=-bsd ;; -dynix*) os=-bsd ;; -acis*) os=-aos ;; -atheos*) os=-atheos ;; -syllable*) os=-syllable ;; -386bsd) os=-bsd ;; -ctix* | -uts*) os=-sysv ;; -nova*) os=-rtmk-nova ;; -ns2 ) os=-nextstep2 ;; -nsk*) os=-nsk ;; # Preserve the version number of sinix5. -sinix5.*) os=`echo $os | sed -e 's|sinix|sysv|'` ;; -sinix*) os=-sysv4 ;; -tpf*) os=-tpf ;; -triton*) os=-sysv3 ;; -oss*) os=-sysv3 ;; -svr4) os=-sysv4 ;; -svr3) os=-sysv3 ;; -sysvr4) os=-sysv4 ;; # This must come after -sysvr4. -sysv*) ;; -ose*) os=-ose ;; -es1800*) os=-ose ;; -xenix) os=-xenix ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) os=-mint ;; -aros*) os=-aros ;; -kaos*) os=-kaos ;; -zvmoe) os=-zvmoe ;; -dicos*) os=-dicos ;; -nacl*) ;; -none) ;; *) # Get rid of the `-' at the beginning of $os. os=`echo $os | sed 's/[^-]*-//'` echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 exit 1 ;; esac else # Here we handle the default operating systems that come with various machines. # The value should be what the vendor currently ships out the door with their # machine or put another way, the most popular os provided with the machine. # Note that if you're going to try to match "-MANUFACTURER" here (say, # "-sun"), then you have to tell the case statement up towards the top # that MANUFACTURER isn't an operating system. Otherwise, code above # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. case $basic_machine in score-*) os=-elf ;; spu-*) os=-elf ;; *-acorn) os=-riscix1.2 ;; arm*-rebel) os=-linux ;; arm*-semi) os=-aout ;; c4x-* | tic4x-*) os=-coff ;; tic54x-*) os=-coff ;; tic55x-*) os=-coff ;; tic6x-*) os=-coff ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 ;; pdp11-*) os=-none ;; *-dec | vax-*) os=-ultrix4.2 ;; m68*-apollo) os=-domain ;; i386-sun) os=-sunos4.0.2 ;; m68000-sun) os=-sunos3 ;; m68*-cisco) os=-aout ;; mep-*) os=-elf ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; or32-*) os=-coff ;; *-tti) # must be before sparc entry or we get the wrong os. os=-sysv3 ;; sparc-* | *-sun) os=-sunos4.1.1 ;; *-be) os=-beos ;; *-haiku) os=-haiku ;; *-ibm) os=-aix ;; *-knuth) os=-mmixware ;; *-wec) os=-proelf ;; *-winbond) os=-proelf ;; *-oki) os=-proelf ;; *-hp) os=-hpux ;; *-hitachi) os=-hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=-sysv ;; *-cbm) os=-amigaos ;; *-dg) os=-dgux ;; *-dolphin) os=-sysv3 ;; m68k-ccur) os=-rtu ;; m88k-omron*) os=-luna ;; *-next ) os=-nextstep ;; *-sequent) os=-ptx ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-nextstep3 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-siemens) os=-sysv4 ;; *-masscomp) os=-rtu ;; f30[01]-fujitsu | f700-fujitsu) os=-uxpv ;; *-rom68k) os=-coff ;; *-*bug) os=-coff ;; *-apple) os=-macos ;; *-atari*) os=-mint ;; *) os=-none ;; esac fi # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. vendor=unknown case $basic_machine in *-unknown) case $os in -riscix*) vendor=acorn ;; -sunos*) vendor=sun ;; -cnk*|-aix*) vendor=ibm ;; -beos*) vendor=be ;; -hpux*) vendor=hp ;; -mpeix*) vendor=hp ;; -hiux*) vendor=hitachi ;; -unos*) vendor=crds ;; -dgux*) vendor=dg ;; -luna*) vendor=omron ;; -genix*) vendor=ns ;; -mvs* | -opened*) vendor=ibm ;; -os400*) vendor=ibm ;; -ptx*) vendor=sequent ;; -tpf*) vendor=ibm ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; -aux*) vendor=apple ;; -hms*) vendor=hitachi ;; -mpw* | -macos*) vendor=apple ;; -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) vendor=atari ;; -vos*) vendor=stratus ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/�����������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013655� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/README�����������������������������������������������������������������0000644�0001750�0001750�00000001236�13021324543�014533� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Used tools ResEdit (http://www.resedit.net/) --------------------------------- Configure to add it include PATH, e.g.: C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\include (must contain windows.h) modify the name of the header file (default: resource.h) set it to w32_resource.h) Icon: ----- Done with gimp. Sizes 16x16, 24x24, 32x32, 64x64 Saved in the resource (and then in the w32guicons.dll). The w32_console uses LoadIcon to set it under the GUI. To also be included in the gprolog.exe file, the same resource file is linked with gprolog.exe. IconExplorer ------------ To visualize icons (also inside exe, dll). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/win_exe_icon.rc��������������������������������������������������������0000644�0001750�0001750�00000000217�13021324543�016645� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������// Simple resource file to add an icon to an executable // Simply pass the resulting .res file to the linker 1 ICON "..\\..\\gprolog.ico" ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/w32gc_interf.h���������������������������������������������������������0000644�0001750�0001750�00000006212�13021324543�016317� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Win32 GUI console * * File : w32gc_interf.c * * Descr.: line editor <--> GUICons interface * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _W32GC_INTERF_H #define _W32GC_INTERF_H #if 1 /* comment if you dont want to activate stack sizes dialog box */ #define GUI_CONSOLE_WITH_STACK_SIZES #endif typedef enum { QUERY_STACK_GET_NB_OF_STACKS, QUERY_STACK_HAS_FIXED_SIZES, QUERY_STACK_GET_NAME, QUERY_STACK_GET_DESC, QUERY_STACK_GET_ENV_VAR_NAME, QUERY_STACK_GET_DEFAULT_SIZE, QUERY_STACK_GET_SIZE }QueryStackCmd; #endif /* !_W32GC_INTERF_H */ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/.gitignore�������������������������������������������������������������0000644�0001750�0001750�00000000157�13021324543�015644� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile USEFUL lcczip lccmake makefile.lcc msvcmake makefile.msvc mingwmake makefile.mingw *.dll *.exp *.res �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/w32_console.rc���������������������������������������������������������0000644�0001750�0001750�00000013534�13021324543�016342� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������// Generated by ResEdit 1.5.11 // Copyright (C) 2006-2012 // http://www.resedit.net #include <windows.h> /* #include <commctrl.h> #include <richedit.h> */ #include "w32_resource.h" // // Menu resources // LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL IDR_MENU MENU { POPUP "&File" { MENUITEM "&Consult...", IDM_CONSULT MENUITEM "C&hange Dir...", IDM_CHDIR MENUITEM "&Insert File Name...", IDM_FILE_NAME MENUITEM SEPARATOR MENUITEM "E&xit", IDM_EXIT } POPUP "&Edit" { MENUITEM "&Copy\tCtrl+C", IDM_COPY MENUITEM "&Paste\tCtrl+V", IDM_PASTE MENUITEM "&Select All\tAlt+A", IDM_SELECT_ALL MENUITEM "&Auto Copy on selection", IDM_COPY_ON_SEL, CHECKED MENUITEM SEPARATOR MENUITEM "Sa&ve Options", IDM_SAVE_OPTIONS } POPUP "&Terminal" { MENUITEM "&Beep on error", IDM_BEEP MENUITEM SEPARATOR MENUITEM "&Wrap mode (break long lines)\tAlt+W", IDM_WRAP MENUITEM SEPARATOR MENUITEM "&Line Buffering", IDM_BUFFERING, CHECKED MENUITEM "&Flush Output", IDM_FLUSH MENUITEM SEPARATOR MENUITEM "&Show Text Console", IDM_SHOW_CONSOLE MENUITEM SEPARATOR MENUITEM "&Change Font...", IDM_FONT } POPUP "Prolog" { MENUITEM "&Interrupt (send ^C)\tCtrl+Alt+C", IDM_INTERRUPT MENUITEM "&Set Prolog memory sizes", IDM_STACK_SIZES } POPUP "&Help" { MENUITEM "&Manual\tF1", IDM_MANUAL MENUITEM "&Index Search\tShift+F1", IDM_INDEX MENUITEM SEPARATOR MENUITEM "&GNU Prolog web page", IDM_WEB MENUITEM SEPARATOR MENUITEM "&About", IDM_ABOUT } } // // Dialog resources // LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL IDD_STACK_SIZES DIALOG 20, 20, 444, 222 STYLE DS_MODALFRAME | DS_SHELLFONT | WS_CAPTION | WS_POPUP | WS_SYSMENU CAPTION "Memory sizes setting" FONT 9, "Ms Shell Dlg" { DEFPUSHBUTTON "&OK", IDOK, 306, 197, 57, 14 PUSHBUTTON "&Cancel", IDCANCEL, 372, 197, 57, 14 EDITTEXT IDC_REG_SZ0, 306, 60, 57, 12, ES_RIGHT | ES_AUTOHSCROLL | ES_NUMBER, WS_EX_STATICEDGE RTEXT "", IDC_STACK_DESC0, 18, 59, 78, 12, SS_RIGHT RTEXT "", IDC_DEF_SZ0, 111, 59, 57, 12, WS_BORDER | SS_RIGHT RTEXT "", IDC_ENV_SZ0, 241, 60, 57, 12, WS_BORDER | SS_RIGHT LTEXT "", IDC_ENV_VAR_NAME0, 176, 60, 57, 12, WS_BORDER | SS_LEFT CTEXT "Default size", IDC_STATIC, 110, 43, 57, 10, SS_CENTER CTEXT "Var/Key name", IDC_STATIC, 177, 43, 56, 10, SS_CENTER CTEXT "Env. var. value", IDC_STATIC, 244, 43, 49, 8, SS_CENTER CTEXT "Registry value", IDC_STATIC, 312, 43, 46, 8, SS_CENTER LTEXT "You can adjust the size of GNU Prolog memory using environment variables and/or registry keys. Here you can modify registry values.\nFor stacks, sizes are in kilobytes (Kb). For the atom table, it is the number of atoms.", IDC_STATIC, 8, 9, 419, 16, SS_LEFT RTEXT "", IDC_STACK_DESC1, 18, 86, 78, 12, SS_RIGHT RTEXT "", IDC_DEF_SZ1, 111, 86, 57, 12, WS_BORDER | SS_RIGHT LTEXT "", IDC_ENV_VAR_NAME1, 176, 86, 57, 12, WS_BORDER | SS_LEFT RTEXT "", IDC_ENV_SZ1, 241, 86, 57, 12, WS_BORDER | SS_RIGHT EDITTEXT IDC_REG_SZ1, 306, 86, 57, 12, ES_RIGHT | ES_AUTOHSCROLL | ES_NUMBER, WS_EX_STATICEDGE RTEXT "", IDC_STACK_DESC2, 18, 113, 78, 12, SS_RIGHT RTEXT "", IDC_DEF_SZ2, 111, 113, 57, 12, WS_BORDER | SS_RIGHT LTEXT "", IDC_ENV_VAR_NAME2, 176, 113, 57, 12, WS_BORDER | SS_LEFT RTEXT "", IDC_ENV_SZ2, 241, 113, 57, 12, WS_BORDER | SS_RIGHT EDITTEXT IDC_REG_SZ2, 306, 113, 57, 12, ES_RIGHT | ES_AUTOHSCROLL | ES_NUMBER, WS_EX_STATICEDGE RTEXT "", IDC_STACK_DESC3, 18, 141, 78, 12, SS_RIGHT RTEXT "", IDC_DEF_SZ3, 111, 141, 57, 12, WS_BORDER | SS_RIGHT LTEXT "", IDC_ENV_VAR_NAME3, 176, 141, 57, 12, WS_BORDER | SS_LEFT RTEXT "", IDC_ENV_SZ3, 241, 141, 57, 12, WS_BORDER | SS_RIGHT EDITTEXT IDC_REG_SZ3, 306, 141, 57, 12, ES_RIGHT | ES_AUTOHSCROLL | ES_NUMBER, WS_EX_STATICEDGE RTEXT "", IDC_CUR_SZ0, 372, 59, 57, 12, WS_BORDER | SS_RIGHT CTEXT "Current size", IDC_STATIC, 383, 43, 38, 8, SS_CENTER RTEXT "", IDC_CUR_SZ1, 372, 86, 57, 12, WS_BORDER | SS_RIGHT RTEXT "", IDC_CUR_SZ2, 372, 113, 57, 12, WS_BORDER | SS_RIGHT RTEXT "", IDC_CUR_SZ3, 372, 141, 57, 12, WS_BORDER | SS_RIGHT LTEXT "", IDC_FIXED_SIZES, 9, 198, 290, 13, SS_LEFT | SS_NOPREFIX RTEXT "", IDC_STACK_DESC4, 18, 170, 78, 12, SS_RIGHT RTEXT "", IDC_DEF_SZ4, 111, 170, 57, 12, WS_BORDER | SS_RIGHT LTEXT "", IDC_ENV_VAR_NAME4, 176, 170, 57, 12, WS_BORDER | SS_LEFT RTEXT "", IDC_ENV_SZ4, 241, 170, 57, 12, WS_BORDER | SS_RIGHT EDITTEXT IDC_REG_SZ4, 306, 170, 57, 12, ES_RIGHT | ES_AUTOHSCROLL | ES_NUMBER, WS_EX_STATICEDGE RTEXT "", IDC_CUR_SZ4, 372, 170, 57, 12, WS_BORDER | SS_RIGHT } // // Accelerator resources // LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL IDR_ACCEL ACCELERATORS { "C", IDM_INTERRUPT, VIRTKEY, ALT "C", IDM_INTERRUPT, VIRTKEY, ALT, CONTROL "C", IDM_COPY, VIRTKEY, CONTROL "V", IDM_PASTE, VIRTKEY, CONTROL "A", IDM_SELECT_ALL, VIRTKEY, ALT "W", IDM_WRAP, VIRTKEY, ALT VK_PAUSE, IDM_INTERRUPT, VIRTKEY, CONTROL VK_F1, IDM_MANUAL, VIRTKEY VK_F1, IDM_INDEX, VIRTKEY, SHIFT } // // Icon resources // LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL IDI_ICON ICON "../../gprolog.ico" ��������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/w32gc_interf.c���������������������������������������������������������0000644�0001750�0001750�00000022327�13021324543�016317� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Win32 GUI console * * File : w32gc_interf.c * * Descr.: line editor <--> GUICons interface * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <windows.h> #include "../EnginePl/gp_config.h" #include "../EnginePl/pl_params.h" /* we include the minimum from ../EnginePl to allow for testing (test_linedit, test_noecho) * with Win GUI console separately (see project MS Visual C++ in ../Linedit) * this implies some redundant definitions (WamWord, Wam_Words_To_KBytes) */ typedef PlLong WamWord; #include "../EnginePl/wam_stacks.h" #include "../EnginePl/atom.h" #define Wam_Words_To_KBytes(ww) (ww * sizeof(WamWord) / 1024) #include "w32gc_interf.h" /* from linedit.h */ extern char *Pl_LE_Get_Separators(void); extern int Pl_LE_Get_Prompt_Length(void); /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static void Start_GUI(int silent); #ifdef GUI_CONSOLE_WITH_STACK_SIZES static PlLong Query_Stack(QueryStackCmd cmd, int stack_no); #endif /* overwrite to customize linedit */ void (*pl_le_hook_start) () = Start_GUI; void (*pl_le_hook_emit_beep) (); void (*pl_le_hook_put_char) (); int (*pl_le_hook_get_char0) (); void (*pl_le_hook_ins_mode) (); void (*pl_le_hook_screen_size) (); int (*pl_le_hook_kbd_is_not_empty) (); void (*pl_le_hook_backd) (); void (*pl_le_hook_forwd) (); void (*pl_le_hook_displ) (); void (*pl_le_hook_displ_str) (); void (*pl_le_hook_erase) (); void (*le_hook_confirm) (); void (*pl_le_hook_set_line_buffering) (); int (*pl_le_hook_get_line_buffering) (); void (*pl_le_hook_flush) (); int (*pl_le_hook_confirm_box) (); void (*pl_le_hook_message_box) (); void (*pl_le_hook_exit_process) (); /*---------------------------------* * Function Prototypes * *---------------------------------*/ static FARPROC Find_Fct(HANDLE h, char *name); #ifdef __GNUC__ typedef int (*Fct) (); #else typedef __declspec(dllimport) int (*Fct) (); #endif /*-------------------------------------------------------------------------* * START_GUI * * * *-------------------------------------------------------------------------*/ static void Start_GUI(int silent) { Fct W32GC_Start_Window; HANDLE h; #if 1 /* O to force console mode */ h = LoadLibrary(DLL_W32GUICONS); #else h = NULL; #endif if (h == NULL) { if (!silent) fprintf(stderr, "warning: cannot load DLL " DLL_W32GUICONS " - text console used (error: %d)\n", (int) GetLastError()); pl_le_hook_start = NULL; return; } pl_le_hook_put_char = (void (*)()) Find_Fct(h, "_W32GC_Put_Char"); pl_le_hook_get_char0 = (int (*)()) Find_Fct(h, "_W32GC_Get_Char0"); pl_le_hook_kbd_is_not_empty = (int (*)()) Find_Fct(h, "_W32GC_Kbd_Is_Not_Empty"); pl_le_hook_screen_size = (void (*)()) Find_Fct(h, "_W32GC_Screen_Size"); /* the following are not mandatory for linedit and could be commented out */ pl_le_hook_emit_beep = (void (*)()) Find_Fct(h, "_W32GC_Emit_Beep"); pl_le_hook_ins_mode = (void (*)()) Find_Fct(h, "_W32GC_Ins_Mode"); pl_le_hook_backd = (void (*)()) Find_Fct(h, "_W32GC_Backd"); pl_le_hook_forwd = (void (*)()) Find_Fct(h, "_W32GC_Forwd"); pl_le_hook_displ = (void (*)()) Find_Fct(h, "_W32GC_Displ"); pl_le_hook_displ_str = (void (*)()) Find_Fct(h, "_W32GC_Displ_Str"); pl_le_hook_erase = (void (*)()) Find_Fct(h, "_W32GC_Erase"); /* the following are not used by linedit but by stream_supp.c */ pl_le_hook_set_line_buffering = (void (*)()) Find_Fct(h, "_W32GC_Set_Line_Buffering"); pl_le_hook_get_line_buffering = (int (*)()) Find_Fct(h, "_W32GC_Get_Line_Buffering"); pl_le_hook_flush = (void (*)()) Find_Fct(h, "_W32GC_Flush"); pl_le_hook_confirm_box = (int (*)()) Find_Fct(h, "_W32GC_Confirm_Box"); pl_le_hook_message_box = (void (*)()) Find_Fct(h, "_W32GC_Message_Box"); pl_le_hook_exit_process = (void (*)()) Find_Fct(h, "_W32GC_Exit_Process"); W32GC_Start_Window = (Fct) Find_Fct(h, "_W32GC_Start_Window"); (*W32GC_Start_Window) (Pl_LE_Get_Separators, Pl_LE_Get_Prompt_Length, #ifdef GUI_CONSOLE_WITH_STACK_SIZES Query_Stack #else NULL #endif ); } /*-------------------------------------------------------------------------* * FIND_FCT * * * *-------------------------------------------------------------------------*/ static FARPROC Find_Fct(HANDLE h, char *name) { FARPROC p; /* init here to avoid lcc (buggy) warning */ p = GetProcAddress(h, name + 1); if (p) return p; /* useless for MSVC++ but useful for lcc for instance */ p = GetProcAddress(h, name); if (p == NULL) { fprintf(stderr, "warning: cannot load fct %s in DLL " DLL_W32GUICONS "\n", name); exit(1); } return p; } #ifdef GUI_CONSOLE_WITH_STACK_SIZES /*-------------------------------------------------------------------------* * QUERY_STACK * * * *-------------------------------------------------------------------------*/ static PlLong Query_Stack(QueryStackCmd cmd, int stack_no) { switch(cmd) { case QUERY_STACK_GET_NB_OF_STACKS: return (PlLong) NB_OF_STACKS + 1; /* +1 for max_atom */ case QUERY_STACK_HAS_FIXED_SIZES: return (PlLong) pl_fixed_sizes; case QUERY_STACK_GET_NAME: if (stack_no == NB_OF_STACKS) return (PlLong) "atoms"; return (PlLong) pl_stk_tbl[stack_no].name; case QUERY_STACK_GET_DESC: if (stack_no == NB_OF_STACKS) return (PlLong) "atom table"; return (PlLong) pl_stk_tbl[stack_no].desc; case QUERY_STACK_GET_ENV_VAR_NAME: if (stack_no == NB_OF_STACKS) return (PlLong) ENV_VAR_MAX_ATOM; return (PlLong) pl_stk_tbl[stack_no].env_var_name; case QUERY_STACK_GET_DEFAULT_SIZE: if (stack_no == NB_OF_STACKS) return (PlLong) DEFAULT_MAX_ATOM; return (PlLong) Wam_Words_To_KBytes(pl_stk_tbl[stack_no].default_size); case QUERY_STACK_GET_SIZE: if (stack_no == NB_OF_STACKS) return (PlLong) pl_max_atom; return (PlLong) Wam_Words_To_KBytes(pl_stk_tbl[stack_no].size); } return 0; } #endif /* GUI_CONSOLE_WITH_STACK_SIZES */ ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/w32_console.c����������������������������������������������������������0000644�0001750�0001750�00000151617�13021324543�016165� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Win32 GUI console * * File : w32_console.c * * Descr.: W32 GUI Console * * Author: Jacob Navia and Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <ctype.h> #include <string.h> #include <malloc.h> #include "../EnginePl/gp_config.h" /* only to know the value of WITH_HTMLHELP */ #include "../EnginePl/pl_params.h" /* only to know the value of PROLOG_FILE_SUFFIX */ #include "../EnginePl/set_locale.h" #include "w32gc_interf.h" /* only to know Query_Stack() cmd constants */ #include "../TopComp/prolog_path.c" #define GUI_VERSION "1.1" #define ADDITIONAL_INFORMATION \ "Windows GUI Console version " GUI_VERSION "\n" \ "By Jacob Navia and Daniel Diaz\n\n" #include "../TopComp/copying.c" #include <windows.h> #include <windowsx.h> #include <commctrl.h> #include <richedit.h> #include <shlobj.h> #include <shellapi.h> #include "w32_resource.h" #ifdef _MSC_VER #define _STATIC_CPPLIB #endif #ifdef WITH_HTMLHELP /* HtmlHelp is used to display the doc (.chm file) * * 1) HtmlHelp can be statically linked (needs htmlhelp.lib or libhtmlhelp.a) * Recent versions of the lib are compiled with security options and needs * external check functions. The link errors are: * * libhtmlhelp.a: undefined reference to `__GSHandlerCheck' * libhtmlhelp.a: undefined reference to `__security_check_cookie' * * __GSHandlerCheck: due to the use MSVC /GS option (enable security check) * Some people solved this linking with a MSVC gshandler.obj but I could not * find it. * * __security_check_cookie: see http://support.microsoft.com/kb/894573 * However, I could never find a valide bufferoverflowu.lib. * The solution consists in a set of fake (dummy) functions. * * 2) HtmlHelp can be dynamically loaded. This avoid the link with the lib * but needs hhctrl.ocx at runtime. */ #ifdef __GNUC__ /* ignore MSVC extensions present in htmlhelp.h */ # define __in # define __out # define __in_opt #endif #include <htmlhelp.h> #if WITH_HTMLHELP == 1 && defined(__GNUC__) void __fastcall __GSHandlerCheck() {} void __fastcall __security_check_cookie(unsigned* p) {} unsigned* __security_cookie; #endif #endif /* !WITH_HTMLHELP */ #if 1 #define DLLEXPORT __declspec(dllexport) #endif #if 0 #define DEBUG #endif /* xxPtr versions should exist now for both 32/64 bits - but in case of... */ #ifndef GetWindowLongPtr #define GetWindowLongPtr GetWindowLong #define SetWindowLongPtr SetWindowLong #endif /*---------------------------------* * Constants * *---------------------------------*/ #define EDIT_FIELD_SIZE 64000 /* 0 does not work ! why ? */ #define FIX_TAB 1 // replace \t by ESC+tab #define FIX_CR 2 // remove \r #define FIX_BACKSLASH 4 // replace \ by / #define FIX_QUOTE 8 // replace ' by '' /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static char *(*fct_get_separators)(); static int (*fct_get_prompt_length)(); static PlLong (*fct_query_stack)(); static unsigned int queue[EDIT_FIELD_SIZE]; static int queue_start, queue_end; static CRITICAL_SECTION cs_queue; static HANDLE event_window_is_ready; static HANDLE event_char_in_queue; #define Queue_Is_Empty() (queue_start == queue_end) #define Enqueue(c) \ do \ { \ queue[queue_end] = c; \ queue_end = (queue_end + 1) % sizeof(queue); \ if (queue_end == queue_start) \ queue_start = (queue_start + 1) % sizeof(queue);\ } \ while(0) #define Dequeue(c) \ do \ { \ c = queue[queue_start]; \ queue_start = (queue_start + 1) % sizeof(queue); \ } \ while(0) static HWND hwndMain; // Main window handle (same as hwnd in most fct) static HWND hwndEditControl; // Edit Control handle static WNDPROC lpEProc; static HINSTANCE hInst; // Instance handle static LOGFONT currentFont; // Used font static HFONT hFont; static int show_console = 0; // is the associated text console shown ? static HWND hwnd_console; static int in_get_char = 0; // inside a Get_Char() ? static int last_is_read = 0; // to know if a msg box should be displayed at exit static int posit = 0; // position inside current (last) line static int ec_start = 0; // position of the begin in the Win edit control (corresponds to posit = 0) static int win_x = CW_USEDEFAULT; // main window pos and size static int win_y = CW_USEDEFAULT; static int win_width = CW_USEDEFAULT; static int win_height = CW_USEDEFAULT; static int copy_on_sel = 1; // default: automatically copy the selection static int wrap_mode = 0; // default: no word wrapping (line break if line > width) static int line_buffering = 1; // default: line buffered static int beep_on_error = 0; // default: no beep static char wr_buffer[10240]; // when full a flush occurs (size does not matter) static char *wr_buffer_ptr = wr_buffer; static int dont_use_selection; // is selection reliable (no if used to move the caret) static char buff_pathname[MAX_PATH]; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int CallMain(void *unused); static int StartWinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, INT nCmdShow); static BOOL InitApplication(void); static HWND Createw32_consoleWndClassWnd(void); static LRESULT CALLBACK MainWndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam); static void MainWndProc_OnCommand(HWND hwnd, int id, HWND hwndCtl, UINT codeNotify); static void Create_Edit_Control(HWND hwnd); static void SubClassEditField(HWND hwnd); static LRESULT CALLBACK SubClassEdit(HWND hwnd, UINT msg, WPARAM mp1, LPARAM mp2); static int CALLBACK WordBreakProc(LPTSTR lpcb, int ichCurrent, int cch, int code); static void Toggle_Wrap_Mode(HWND hwnd); static HFONT Create_Courier_Font(void); static int Change_Font(HWND hwnd); BOOL CALLBACK StackSizesProc(HWND hwndDlg, UINT message, WPARAM wParam, LPARAM lParam); static void Load_Options(void); static void Save_Options(void); static void Activate_Options(void); static char *Get_Current_Word(int select_it); static void Consult_File(void); static void Change_Directory(void); static void Insert_File_Name(void); static char *Get_Selected_File_Name(char *title, char *default_ext, char *filter); static char *Get_Selected_Directory(char *title, int new_folder); static void Show_Help(char *word); static int Get_CHM_Help_Path(char *path); static int WINAPI BrowseCallbackProc(HWND hwnd, UINT uMsg, LPARAM lp, LPARAM pData); static void Add_Clipboard_To_Queue(void); static void Add_String_To_Queue(char *str, int mask_fix); static void Add_Char_To_Queue(int c); static void Set_Selection(int posit, int n); static void Set_Caret_Position(int posit); static int Move_Caret_To(int start_or_end); static void Move_Caret_From_Mouse(int if_no_selection); static int Delete_Selection(void); static void Display_Text(char *str, int n); static void Flush_Buffer(void); #ifdef DEBUG static int Console_Printf(char *format, ...); #endif DLLEXPORT void W32GC_Set_Line_Buffering(int is_buffered); DLLEXPORT void W32GC_Backd(int n); DLLEXPORT int W32GC_Confirm_Box(char *titre, char *msg); static BOOL Launched_From_Command_Line(); static HWND Find_Text_Console_Handle(void); static void Show_Text_Console(int show); #define SET_CHECKED_OPT(idm_cmd, var) \ CheckMenuItem(GetMenu(hwndMain), idm_cmd, (var) ? MF_CHECKED : MF_UNCHECKED) /* from terminal.h */ #if 0 #define KEY_CTRL(x) ((x) & 0x1f) #define KEY_ESC(x) ((2<<8) | ((x)|0x20)) #else #include "../Linedit/terminal.h" #endif /*<---------------------------------------------------------------------->*/ #ifdef __LCC__ #define DllMain LibMain #endif BOOL DLLEXPORT WINAPI DllMain(HINSTANCE hDLLInst, DWORD fdwReason, LPVOID lpvReserved) { switch (fdwReason) { case DLL_PROCESS_ATTACH: // The DLL is being loaded for the first time by a given process. // Perform per-process initialization here. If the initialization // is successful, return TRUE; if unsuccessful, return FALSE. hInst = hDLLInst; break; case DLL_PROCESS_DETACH: // The DLL is being unloaded by a given process. Do any // per-process clean up here, such as undoing what was done in // DLL_PROCESS_ATTACH. The return value is ignored. break; case DLL_THREAD_ATTACH: // A thread is being created in a process that has already loaded // this DLL. Perform any per-thread initialization here. The // return value is ignored. break; case DLL_THREAD_DETACH: // A thread is exiting cleanly in a process that has already // loaded this DLL. Perform any per-thread clean up here. The // return value is ignored. break; } return TRUE; } /* get_separators can be NULL (default separators are used). * * get_prompt_length can be NULL (prompt length supposed to be 0) * only relevant when the user clicks inside the last line inside the prompt * having the length we can consider it similarly to when he clicks above * (to set the cursor for a copy/paste). * not having the length we try to move the cursor (sending left arrows) * the application (e.g. linedit) then needs to detect an invalid left arrow * and ignore it (e.g. emit a beep). Anyway the user can copy/paste the prompt. * So NULL is really OK. */ DLLEXPORT int W32GC_Start_Window(char *(*get_separators)(), int (*get_prompt_length)(), PlLong (*query_stack)()) { DWORD tid; Load_Options(); fct_get_separators = get_separators; fct_get_prompt_length = get_prompt_length; fct_query_stack = query_stack; hwnd_console = Find_Text_Console_Handle(); show_console |= Launched_From_Command_Line(); /* from command-line keep the console ! */ InitializeCriticalSection(&cs_queue); event_window_is_ready = CreateEvent(NULL, FALSE, FALSE, NULL); CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE) CallMain, hwndMain, 0, &tid); // wait until windows manager ok in the thread WaitForSingleObject(event_window_is_ready, INFINITE); CloseHandle(event_window_is_ready); return 1; } static int CallMain(void *unused) { StartWinMain(hInst, 0, "", SW_SHOW); return 0; } static int StartWinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, INT nCmdShow) { MSG msg; HACCEL hAccelTable; /* Reinit the locale in the DLL in case it has its own CRT * (or else compile with MSVC option -MD) */ Set_Locale(); hInst = hInstance; event_char_in_queue = CreateEvent(NULL, FALSE, FALSE, NULL); if (!InitApplication()) return 0; hAccelTable = LoadAccelerators(hInst, MAKEINTRESOURCE(IDR_ACCEL)); if ((hwndMain = Createw32_consoleWndClassWnd()) == (HWND) 0) return 0; ShowWindow(hwndMain, SW_SHOW); Activate_Options(); if (fct_query_stack == NULL) EnableMenuItem(GetMenu(hwndMain), IDM_STACK_SIZES, MF_BYCOMMAND | MF_GRAYED); while (GetMessage(&msg, NULL, 0, 0)) { if (!TranslateAccelerator(hwndMain, hAccelTable, &msg)) { TranslateMessage(&msg); DispatchMessage(&msg); } } CloseHandle(event_char_in_queue); DeleteCriticalSection(&cs_queue); DestroyAcceleratorTable(hAccelTable); return msg.wParam; } static BOOL InitApplication(void) { WNDCLASS wc; memset(&wc, 0, sizeof(WNDCLASS)); wc.style = CS_HREDRAW | CS_VREDRAW | CS_DBLCLKS; wc.lpfnWndProc = (WNDPROC) MainWndProc; wc.hInstance = hInst; wc.hbrBackground = (HBRUSH) (COLOR_WINDOW + 1); wc.lpszClassName = "w32_consoleWndClass"; wc.lpszMenuName = MAKEINTRESOURCE(IDR_MENU); wc.hCursor = LoadCursor(NULL, IDC_ARROW); // wc.hIcon = LoadIcon(NULL, IDI_WINLOGO); wc.hIcon = LoadIcon(hInst, MAKEINTRESOURCE(IDI_ICON)); if (!RegisterClass(&wc)) return 0; return 1; } static HWND Createw32_consoleWndClassWnd(void) { return CreateWindow("w32_consoleWndClass", "GNU Prolog console", WS_MINIMIZEBOX | WS_VISIBLE | WS_CLIPSIBLINGS | WS_CLIPCHILDREN | WS_MAXIMIZEBOX | WS_CAPTION | WS_BORDER | WS_SYSMENU | WS_THICKFRAME, win_x, win_y, win_width, win_height, NULL, NULL, hInst, NULL); } static LRESULT CALLBACK MainWndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { PAINTSTRUCT ps; switch (msg) { case WM_CREATE: Create_Edit_Control(hwnd); SetEvent(event_window_is_ready); return 0; /* 0 means message has been treated */ case WM_SIZE: MoveWindow(hwndEditControl, 0, 0, LOWORD(lParam), HIWORD(lParam), TRUE); SendMessage(hwndEditControl, EM_SCROLLCARET, 0, 0); // be sure the caret is visble return 0; case WM_SETFOCUS: SetFocus(hwndEditControl); return 0; case WM_COMMAND: HANDLE_WM_COMMAND(hwnd, wParam, lParam, MainWndProc_OnCommand); return 0; #if 0 case WM_CLOSE: if (!W32GC_Confirm_Box("GNU Prolog", "Really quit ?")) return 0; break; #endif case WM_PAINT: BeginPaint(hwnd, &ps); EndPaint(hwnd, &ps); return 0; case WM_DESTROY: PostQuitMessage(0); exit(0); return 0; } return DefWindowProc(hwnd, msg, wParam, lParam); } static void MainWndProc_OnCommand(HWND hwnd, int id, HWND hwndCtl, UINT codeNotify) { switch (id) { case IDM_CONSULT: Consult_File(); break; case IDM_CHDIR: Change_Directory(); break; case IDM_FILE_NAME: Insert_File_Name(); break; case IDM_EXIT: PostMessage(hwnd, WM_CLOSE, 0, 0); break; case IDM_COPY: SendMessage(hwndEditControl, WM_COPY, 0, 0); break; case IDM_PASTE: Add_Clipboard_To_Queue(); break; case IDM_SELECT_ALL: SendMessage(hwndEditControl, EM_SETSEL, 0, -1); if (copy_on_sel) SendMessage(hwndEditControl, WM_COPY, 0, 0); break; case IDM_SAVE_OPTIONS: Save_Options(); break; case IDM_COPY_ON_SEL: copy_on_sel = 1 - copy_on_sel; SET_CHECKED_OPT(IDM_COPY_ON_SEL, copy_on_sel); break; case IDM_INTERRUPT: if (in_get_char) Add_Char_To_Queue(KEY_CTRL('C')); else GenerateConsoleCtrlEvent(CTRL_C_EVENT, 0); break; case IDM_STACK_SIZES: /* DialogBox() returns IDOK if validated by button OK (else aborted by button CANCEL) */ DialogBox(hInst, MAKEINTRESOURCE(IDD_STACK_SIZES), hwndMain, (DLGPROC) StackSizesProc); break; case IDM_WRAP: Toggle_Wrap_Mode(hwnd); break; case IDM_BEEP: beep_on_error = 1 - beep_on_error; SET_CHECKED_OPT(IDM_BEEP, beep_on_error); break; case IDM_BUFFERING: line_buffering = 1 - line_buffering; W32GC_Set_Line_Buffering(line_buffering); break; case IDM_FLUSH: Flush_Buffer(); break; case IDM_SHOW_CONSOLE: show_console = 1 - show_console; Show_Text_Console(show_console); SetFocus(hwndEditControl); break; case IDM_FONT: Change_Font(hwnd); break; case IDM_MANUAL: Show_Help(NULL); break; case IDM_INDEX: Show_Help(Get_Current_Word(1)); break; case IDM_WEB: ShellExecute(NULL, "open", "http://www.gprolog.org/", NULL, ".", 0); break; case IDM_ABOUT: MessageBox(hwndMain, Mk_Copying_Message(NULL), "About GNU Prolog", MB_OK | MB_ICONINFORMATION); break; } } /*<---------------------------------------------------------------------->*/ static void Create_Edit_Control(HWND hwnd) { RECT rc; GetClientRect(hwnd, &rc); hwndEditControl = CreateWindow("EDIT", NULL, WS_CHILD | WS_VISIBLE | ES_MULTILINE | WS_VSCROLL | ES_AUTOVSCROLL | (wrap_mode ? 0 : (WS_HSCROLL | ES_AUTOHSCROLL)) | ES_NOHIDESEL, 0, 0, (rc.right - rc.left), (rc.bottom - rc.top), hwnd, (HMENU) 1000, hInst, NULL); SetWindowLongPtr(hwnd, DWLP_USER, (LONG_PTR) hwndEditControl); SendMessage(hwndEditControl, WM_SETFONT, (WPARAM) hFont, 0L); SubClassEditField(hwndEditControl); SendMessage(hwndEditControl, EM_SETLIMITTEXT, EDIT_FIELD_SIZE, 0); if (wrap_mode) SendMessage(hwndEditControl, EM_SETWORDBREAKPROC, (WPARAM) 0, (LPARAM) WordBreakProc); SetFocus(hwndEditControl); } static void SubClassEditField(HWND hwnd) { if (lpEProc == NULL) lpEProc = (WNDPROC) GetWindowLongPtr(hwnd, GWLP_WNDPROC); SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) SubClassEdit); } static LRESULT CALLBACK SubClassEdit(HWND hwnd, UINT msg, WPARAM mp1, LPARAM mp2) { LRESULT r; int c, del, repeat, hasShift, hasAlt, hasCtrl; unsigned char pKeyState[256]; int modif; GetKeyboardState(pKeyState); hasShift = (pKeyState[VK_SHIFT] & (unsigned char) 0x80); hasAlt = (pKeyState[VK_MENU] & (unsigned char) 0x80); /* needs WM_SYSKEYDOWN */ hasCtrl = (pKeyState[VK_CONTROL] & (unsigned char) 0x80); if (msg == WM_CHAR) { repeat = (int) (mp2 & 0xffff); if (hasCtrl && !hasAlt) /* only needed for ^space (for ^A mp1 is already 1, but not for ^space) */ mp1 = KEY_CTRL(mp1); /* we test !hasAlt because AltGr is the same as Ctrl+Alt */ del = (mp1 == '\b' || mp1 == KEY_CTRL('D') || isprint(mp1)) ? Delete_Selection() : 0; if (del && (mp1 == '\b' || mp1 == KEY_CTRL('D')) && --repeat == 0) return 0; while (repeat--) Add_Char_To_Queue(mp1); return 0; } if (msg == WM_KEYDOWN || msg == WM_SYSKEYDOWN) /* WM_SYSKEYDOWN is to handle left Alt key */ { #if 0 /* now done by accelerators defined in resources */ if ((mp1 == 'c' || mp1 == 'C') && hasCtrl) { SendMessage(hwndMain, WM_COMMAND, IDM_COPY, 0); return 0; } if ((mp1 == 'v' || mp1 == 'V') && hasCtrl) { SendMessage(hwndMain, WM_COMMAND, IDM_PASTE, 0); return 0; } #endif modif = KEY_MODIF_NONE; if (hasShift) modif |= KEY_MODIF_SHIFT; if (hasAlt) modif |= KEY_MODIF_ALT; if (hasCtrl) modif |= KEY_MODIF_CTRL; c = KEY_ID2(modif, mp1); switch (mp1) { case VK_NEXT: /* default vertical scroll behavior */ case VK_PRIOR: if (!hasCtrl && !hasAlt) break; goto return_key; case VK_DELETE: /* default: delete selection */ if (Delete_Selection()) break; goto return_key; case VK_HOME: case VK_END: case VK_LEFT: case VK_RIGHT: case VK_UP: case VK_DOWN: case VK_INSERT: case VK_F1: #ifndef DEBUG case VK_F2: case VK_F3: case VK_F4: #endif case VK_F5: case VK_F6: case VK_F7: case VK_F8: case VK_F9: case VK_F10: case VK_F11: case VK_F12: return_key: #if 0 printf("modif: %d code: %d\n", modif, mp1); #endif Move_Caret_From_Mouse(0); Add_Char_To_Queue(c); return 0; #if 0 case VK_F1: /* now done by an accelerator */ Show_Help(Get_Current_Word(1)); return 0; #endif #ifdef DEBUG /* to include a test code */ case VK_F2: { int size = SendMessage(hwndEditControl, EM_GETLIMITTEXT, 0, 0); int len = SendMessage(hwndEditControl, WM_GETTEXTLENGTH, 0, 0); char s[100]; int beg, end; Set_Selection(3, 200); SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &beg, (WPARAM) &end); sprintf(s,"limit: %d len: %d sel: %d-%d", size, len, beg, end); MessageBox(NULL, s, "Error", MB_OK); // size += 10; SendMessage(hwndEditControl, EM_SETLIMITTEXT, size, 0); return 0; } case VK_F3: { char s[100]; Save_Options(); sprintf(s, "cur word: <%s>", Get_Current_Word(1)); MessageBox(NULL, s, "Error", MB_OK); return 0; } case VK_F4: { } return 0; #endif } } if (msg == WM_RBUTTONUP) /* deactivate right buttom (replace by paste) */ { Add_Clipboard_To_Queue(); return 0; } if (msg == WM_MBUTTONUP) /* middle buttom = paste*/ { Add_Clipboard_To_Queue(); return 0; } if (msg == WM_LBUTTONDBLCLK) /* double-click: select word */ { // r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2); Get_Current_Word(1); return 0; } /* default behavior */ r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2); if (msg == WM_LBUTTONUP) /* left button (inside cur line) move the caret */ Move_Caret_From_Mouse(1); return r; } /* This WordBreakProc is to avoid word wrapping * (we simply want "char wrapping": a line break occurs when the line is full) * just return 0 */ static int CALLBACK WordBreakProc(LPTSTR lpcb, int ichCurrent, int cch, int code) { return 0; } static void Toggle_Wrap_Mode(HWND hwnd) { int start, end; int text_size; char *text; wrap_mode = 1 - wrap_mode; SET_CHECKED_OPT(IDM_WRAP, wrap_mode); /* Destroy and recreate the edit control window. For no wrapping pass the options * AUTOHSCROLL | HSCROLL (for wrapping do not pass them). */ LockWindowUpdate(hwnd); /* lock to avoid flicking */ SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &start, (LPARAM) &end); // save selection text_size = SendMessage(hwndEditControl, WM_GETTEXTLENGTH, 0, 0) + 1; // + 1 for '\0' text = malloc(text_size); // for the '\0' if (text != NULL) { SendMessage(hwndEditControl, WM_GETTEXT, (WPARAM) text_size, (LPARAM) text); /* save the text */ ShowWindow(hwndEditControl, SW_HIDE); /* hide and destroy current edit control */ DestroyWindow(hwndEditControl); Create_Edit_Control(hwnd); /* re-create the edit control and show it */ ShowWindow(hwndEditControl, SW_SHOW); SendMessage(hwndEditControl, WM_SETTEXT, (WPARAM) 0, (LPARAM) text); /* re-copy saved text */ SendMessage(hwndEditControl, EM_SETSEL, (WPARAM) start, (LPARAM) end); // restore selection SendMessage(hwndEditControl, EM_SCROLLCARET, 0, 0); // be sure the caret is visble free(text); } LockWindowUpdate(NULL); /* unlock the window */ } /*<---------------------------------------------------------------------->*/ static HFONT Create_Courier_Font(void) { memset(¤tFont, 0, sizeof(LOGFONT)); currentFont.lfCharSet = ANSI_CHARSET; currentFont.lfWeight = FW_NORMAL; currentFont.lfHeight = 18; currentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN); strcpy(currentFont.lfFaceName, "Courier"); /* Courier */ return CreateFontIndirect(¤tFont); } static int Change_Font(HWND hwnd) { LOGFONT lf; CHOOSEFONT cf; memset(&cf, 0, sizeof(CHOOSEFONT)); memcpy(&lf, ¤tFont, sizeof(LOGFONT)); cf.lStructSize = sizeof(CHOOSEFONT); cf.hwndOwner = hwnd; cf.lpLogFont = &lf; cf.Flags = CF_SCREENFONTS | CF_FIXEDPITCHONLY | CF_INITTOLOGFONTSTRUCT; cf.nFontType = SCREEN_FONTTYPE; if (!ChooseFont(&cf)) return 0; memcpy(¤tFont, &lf, sizeof(LOGFONT)); hFont = CreateFontIndirect(¤tFont); SendMessage(hwndEditControl, WM_SETFONT, (WPARAM) hFont, 0); InvalidateRect(hwndEditControl, NULL, 1); SendMessage(hwndEditControl, EM_SCROLLCARET, 0, 0); return 1; } /*<---------------------------------------------------------------------->*/ struct { int idc_desc; int idc_def_sz; int idc_env_var_name; int idc_env_var_sz; int idc_reg_sz; int idc_cur_sz; } stk[] = { { IDC_STACK_DESC0, IDC_DEF_SZ0, IDC_ENV_VAR_NAME0, IDC_ENV_SZ0, IDC_REG_SZ0, IDC_CUR_SZ0 }, { IDC_STACK_DESC1, IDC_DEF_SZ1, IDC_ENV_VAR_NAME1, IDC_ENV_SZ1, IDC_REG_SZ1, IDC_CUR_SZ1 }, { IDC_STACK_DESC2, IDC_DEF_SZ2, IDC_ENV_VAR_NAME2, IDC_ENV_SZ2, IDC_REG_SZ2, IDC_CUR_SZ2 }, { IDC_STACK_DESC3, IDC_DEF_SZ3, IDC_ENV_VAR_NAME3, IDC_ENV_SZ3, IDC_REG_SZ3, IDC_CUR_SZ3 }, /* for max_atom */ { IDC_STACK_DESC4, IDC_DEF_SZ4, IDC_ENV_VAR_NAME4, IDC_ENV_SZ4, IDC_REG_SZ4, IDC_CUR_SZ4 } }; BOOL CALLBACK StackSizesProc(HWND hwndDlg, UINT message, WPARAM wParam, LPARAM lParam) { int nb_stk, i; char *desc, *env_var_name, *p; int def_sz, cur_sz; DWORD reg_sz; BOOL ok; switch (message) { case WM_INITDIALOG: if ((*fct_query_stack)(QUERY_STACK_HAS_FIXED_SIZES, 0)) { SetDlgItemText(hwndDlg, IDC_FIXED_SIZES, "This application is compiled with fixed stack sizes, " "it ignores customized stack sizes."); #if 0 // change style: border around HWND hwndFixed = GetDlgItem(hwndDlg, IDC_FIXED_SIZES); LONG_PTR style = GetWindowLongPtr(hwndFixed, GWL_STYLE); SetWindowLongPtr(hwndFixed, GWL_STYLE, style | WS_BORDER); /* NB: after changing a style it is necessary to call SetWindowPos * to alert Windows that the window has changed (Humm) */ SetWindowPos(hwndFixed, NULL, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOZORDER | SWP_FRAMECHANGED); #endif } else { SetDlgItemText(hwndDlg, IDC_FIXED_SIZES, "New sizes will be taken into account at the next restart."); } nb_stk = (*fct_query_stack)(QUERY_STACK_GET_NB_OF_STACKS, 0); for (i = 0; i < nb_stk; i++) { desc = (char *) (*fct_query_stack)(QUERY_STACK_GET_DESC, i); env_var_name = (char *) (*fct_query_stack)(QUERY_STACK_GET_ENV_VAR_NAME, i); def_sz = (*fct_query_stack)(QUERY_STACK_GET_DEFAULT_SIZE, i); cur_sz = (*fct_query_stack)(QUERY_STACK_GET_SIZE, i); SetDlgItemText(hwndDlg, stk[i].idc_desc, desc); SetDlgItemInt(hwndDlg, stk[i].idc_def_sz, def_sz, FALSE); SetDlgItemText(hwndDlg, stk[i].idc_env_var_name, env_var_name); if ((p = getenv(env_var_name)) != NULL) SetDlgItemText(hwndDlg, stk[i].idc_env_var_sz, p); if (Read_Windows_Registry(env_var_name, REG_DWORD, ®_sz, sizeof(reg_sz))) SetDlgItemInt(hwndDlg, stk[i].idc_reg_sz, reg_sz, FALSE); SetDlgItemInt(hwndDlg, stk[i].idc_cur_sz, cur_sz, FALSE); } return 0; case WM_COMMAND: switch (LOWORD(wParam)) { case IDOK: nb_stk = (*fct_query_stack)(QUERY_STACK_GET_NB_OF_STACKS, 0); for (i = 0; i < nb_stk; i++) { env_var_name = (char *) (*fct_query_stack)(QUERY_STACK_GET_ENV_VAR_NAME, i); reg_sz = GetDlgItemInt(hwndDlg, stk[i].idc_reg_sz, &ok, FALSE); if (reg_sz > 0 && ok) /* in fact if !ok returned value = 0 (could pass NULL for ok) */ Write_Windows_Registry(env_var_name, REG_DWORD, ®_sz, sizeof(reg_sz)); else Delete_Windows_Registry(env_var_name); } // then in IDCANCEL to also execute EndDialog() case IDCANCEL: EndDialog(hwndDlg, wParam); return TRUE; } } return FALSE; } /*<---------------------------------------------------------------------->*/ #define READ_INT_REG(key_name, var) \ { \ DWORD x; \ if (Read_Windows_Registry(key_name, REG_DWORD, &x, sizeof(x)))\ var = x; \ } #define WRITE_INT_REG(key_name, var) \ { \ DWORD x = (DWORD) var; \ Write_Windows_Registry(key_name, REG_DWORD, &x, sizeof(x)); \ } #define READ_BOOL_REG(key_name, var) \ { \ unsigned char x; \ if (Read_Windows_Registry(key_name, REG_BINARY, &x, 1)) \ var = x; \ } #define WRITE_BOOL_REG(key_name, var) \ { \ unsigned char x = (unsigned char) var; \ Write_Windows_Registry(key_name, REG_BINARY, &x, 1); \ } static void Save_Options(void) { WINDOWPLACEMENT wndpl; WRITE_BOOL_REG("GUIAutoCopyOnSel", copy_on_sel); WRITE_BOOL_REG("GUIBeepOnError", beep_on_error); WRITE_BOOL_REG("GUIWrapMode", wrap_mode); WRITE_BOOL_REG("GUILineBuffering", line_buffering); WRITE_BOOL_REG("GUIShowTextConsole", show_console); if (GetWindowPlacement(hwndMain, &wndpl)) { RECT rc = wndpl.rcNormalPosition; win_x = rc.left; win_y = rc.top; win_width = rc.right - rc.left; win_height = rc.bottom - rc.top; //printf("CURR %d / %d %d x %d\n", win_x, win_y, win_width, win_height); WRITE_INT_REG("GUIPosX", win_x); WRITE_INT_REG("GUIPosY", win_y); WRITE_INT_REG("GUIWidth", win_width); WRITE_INT_REG("GUIHeight", win_height); } Write_Windows_Registry("GUIFont", REG_BINARY, ¤tFont, sizeof(currentFont)); } static void Load_Options(void) { LOGFONT lf; READ_INT_REG("GUIPosX", win_x); READ_INT_REG("GUIPosY", win_y); READ_INT_REG("GUIWidth", win_width); READ_INT_REG("GUIHeight", win_height); READ_BOOL_REG("GUIAutoCopyOnSel", copy_on_sel); READ_BOOL_REG("GUIBeepOnError", beep_on_error); READ_BOOL_REG("GUIWrapMode", wrap_mode); READ_BOOL_REG("GUILineBuffering", line_buffering); READ_BOOL_REG("GUIShowTextConsole", show_console); if (Read_Windows_Registry("GUIFont", REG_BINARY, &lf, sizeof(lf))) { currentFont = lf; hFont = CreateFontIndirect(¤tFont); } else hFont = Create_Courier_Font(); /* default font */ } static void Activate_Options(void) { SET_CHECKED_OPT(IDM_COPY_ON_SEL, copy_on_sel); SET_CHECKED_OPT(IDM_BEEP, beep_on_error); SET_CHECKED_OPT(IDM_WRAP, wrap_mode); SET_CHECKED_OPT(IDM_BUFFERING, line_buffering); W32GC_Set_Line_Buffering(line_buffering); Show_Text_Console(show_console); } /*<---------------------------------------------------------------------->*/ #define Is_A_Sep(c) (!isprint(c) || (strchr(separators, c) != NULL)) static char * Get_Current_Word(int select_it) { static char *text = NULL; int text_size; int start, end; char *p, *q; // default separators must not be static (else the default value can be changed) char *separators = " ,;:-'\"!@$#^&()-+*/\\[]|<=>`~{}"; if (text != NULL) free(text); text_size = SendMessage(hwndEditControl, WM_GETTEXTLENGTH, 0, 0) + 1; // + 1 for '\0' text = malloc(text_size); // for the '\0' if (text == NULL) return ""; SendMessage(hwndEditControl, WM_GETTEXT, (WPARAM) text_size, (LPARAM) text); /* save the text */ SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &start, (LPARAM) &end); if (fct_get_separators) separators = (*fct_get_separators)(); p = q = text + start; if (!Is_A_Sep(*p)) /* else an empty word */ { while (p >= text && !Is_A_Sep(*p)) p--; p++; while (*q && !Is_A_Sep(*q)) q++; } *q = '\0'; if (select_it) { SendMessage(hwndEditControl, EM_SETSEL, (WPARAM) (p - text), (LPARAM) (q - text)); if (copy_on_sel) SendMessage(hwndEditControl, WM_COPY, 0, 0); } return p; } static void Consult_File(void) { char *p = Get_Selected_File_Name("Consult...", PROLOG_FILE_SUFFIX, "Prolog Files (%s)=%S!All Files=*.*"); if (p == NULL) return; Add_Char_To_Queue(KEY_CTRL('A')); Add_Char_To_Queue(KEY_CTRL('K')); Add_String_To_Queue("consult('", 0); Add_String_To_Queue(p, FIX_TAB | FIX_CR | FIX_BACKSLASH | FIX_QUOTE); Add_String_To_Queue("').\n", 0); } static void Change_Directory(void) { char *p = Get_Selected_Directory("Select working directory", 1); if (p == NULL) return; Add_Char_To_Queue(KEY_CTRL('A')); Add_Char_To_Queue(KEY_CTRL('K')); Add_String_To_Queue("change_directory('", 0); Add_String_To_Queue(p, FIX_TAB | FIX_CR | FIX_BACKSLASH | FIX_QUOTE); Add_String_To_Queue("').\n", 0); #ifdef DEBUG SetCurrentDirectory(p); #endif } static void Insert_File_Name(void) { char *p = Get_Selected_File_Name("Pick a file name...", NULL, "Prolog Files (%s)=%S!All Files=*.*"); if (p == NULL) return; Add_Char_To_Queue('\''); Add_String_To_Queue(p, FIX_TAB | FIX_CR | FIX_BACKSLASH | FIX_QUOTE); Add_Char_To_Queue('\''); } static char * Make_Windows_Filter(char *filter) { static char buff_filter[128]; char suffixes[] = PROLOG_FILE_SUFFIX PROLOG_FILE_SUFFIXES_ALT; char suffix_spac[64], *s1; /* buff for Prolog suffixes separared by space (%s) */ char suffix_star[64], *s2; /* buff for *.Prolog suffixes separared by semicolon (%S) */ int len1 = 0, len2 = 0; char *p, *q; /* %s is replaced by Prolog suffixes .xxx .yyy .zzz (space separated) * %S is replaced by Prolog suffixes *.xxx;*.yyy;*.zzz (semi-colon separated) */ s1 = suffix_spac; s2 = suffix_star; for(p = suffixes; *p; p = q + 1) { q = strchr(p, '|'); *q = '\0'; sprintf(s1, "%s ", p); s1 += strlen(s1); sprintf(s2, "*%s;", p); s2 += strlen(s2); p = q + 1; } s1[-1] = s2[-1] = '\0'; /* skip last separator (space or ;) */ for(p = buff_filter; *filter; filter++) { switch(*filter) { case '=': case '!': *p++ = '\0'; break; case '%': /* %s (space) or %S (star) */ q = (*++filter == 's') ? suffix_spac : suffix_star; strcpy(p, q); p += strlen(p); break; default: *p++ = *filter; } } *p++ = '\0'; *p = '\0'; return buff_filter; } static char * Get_Selected_File_Name(char *title, char *default_ext, char *filter) { static char cwd[MAX_PATH]; static char last_cwd[MAX_PATH]; OPENFILENAME ofn; if (GetCurrentDirectory(sizeof(cwd), cwd) != 0 && strcmp(cwd, last_cwd) != 0) strcpy(last_cwd, cwd); else strcpy(cwd, "."); #if 0 printf("USED DIR: %s\n", cwd); #endif memset(&ofn,0,sizeof(ofn)); ofn.lStructSize = sizeof(ofn); ofn.hwndOwner = GetActiveWindow(); ofn.hInstance = GetModuleHandle(NULL); ofn.lpstrFilter = Make_Windows_Filter(filter); ofn.nFilterIndex = 0; ofn.lpstrFile = buff_pathname; ofn.nMaxFile = sizeof(buff_pathname); ofn.lpstrTitle = title; ofn.lpstrDefExt = (default_ext) ? default_ext + 1 : NULL; /* +1 to skip the priod (.) */ ofn.lpstrInitialDir = cwd; *buff_pathname = '\0'; ofn.Flags = OFN_EXPLORER | OFN_HIDEREADONLY | OFN_ENABLESIZING | OFN_PATHMUSTEXIST ; return GetOpenFileName(&ofn) ? buff_pathname : NULL; } #ifndef BIF_NEWDIALOGSTYLE #define BIF_NEWDIALOGSTYLE 0x40 // new style #endif #ifndef BIF_NONEWFOLDERBUTTON #define BIF_NONEWFOLDERBUTTON 0x0200 // dont show "create new folder" button #endif static char * Get_Selected_Directory(char *title, int new_folder) { LPMALLOC pMalloc; BROWSEINFO browseInfo; LPITEMIDLIST lpItemIDList; CoInitialize(0); // needed for BIF_NEWDIALOGSTYLE if (S_OK != SHGetMalloc(&pMalloc)) return 0; memset(&browseInfo, 0, sizeof(BROWSEINFO)); browseInfo.hwndOwner = GetActiveWindow(); browseInfo.lpszTitle = title; browseInfo.lpfn = BrowseCallbackProc; browseInfo.ulFlags = BIF_NEWDIALOGSTYLE; if (!new_folder) browseInfo.ulFlags |= BIF_NONEWFOLDERBUTTON; lpItemIDList = SHBrowseForFolder(&browseInfo); *buff_pathname = '\0'; if (lpItemIDList != NULL) { SHGetPathFromIDList(lpItemIDList, buff_pathname); pMalloc->lpVtbl->Free(pMalloc, lpItemIDList); } pMalloc->lpVtbl->Release(pMalloc); CoUninitialize(); return (*buff_pathname) ? buff_pathname : NULL; } static int WINAPI BrowseCallbackProc(HWND hwnd, UINT uMsg, LPARAM lp, LPARAM pData) { switch (uMsg) { case BFFM_INITIALIZED: { if (GetCurrentDirectory(sizeof(buff_pathname), buff_pathname)) { // WParam is TRUE since you are passing a path. // It would be FALSE if you were passing a pidl. SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) buff_pathname); } break; } case BFFM_SELCHANGED: { // Set the status window to the currently selected path. if (SHGetPathFromIDList((LPITEMIDLIST) lp, buff_pathname)) { SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) buff_pathname); } break; } default: break; } return 0; } static void Show_Help(char *word) { #ifdef WITH_HTMLHELP char help_path[1024]; HWND hwnd = 0; // or GetDesktopWindow(); UINT command; HH_AKLINK link; DWORD_PTR data; #if defined(WITH_HTMLHELP) && WITH_HTMLHELP == 2 /* load HtmlHelp dynamically */ typedef HWND (WINAPI *FHH)(); HINSTANCE inst; static FHH HtmlHelp; if (HtmlHelp == NULL && ((inst = LoadLibrary("hhctrl.ocx")) == NULL || (HtmlHelp = (FHH) GetProcAddress(inst, "HtmlHelpA")) == NULL)) { MessageBox(NULL, "Error loading hhctrl.ocx / HtmlHelpA", "Error", MB_OK); return; } #endif if (!Get_CHM_Help_Path(help_path)) /* if CANCEL, abort */ return; if (word == NULL) /* open first page of the manual */ { /* use strcat(help_path, "::/file.html#target") to open a specific page+target */ command = HH_DISPLAY_TOPIC; data = 0; } else { link.cbStruct = sizeof(HH_AKLINK); link.fReserved = FALSE; link.pszKeywords = word; link.pszUrl = NULL; // or .chm://index.html ? link.pszMsgText = NULL; link.pszMsgTitle = NULL; link.pszWindow = NULL; link.fIndexOnFail = TRUE; command = HH_KEYWORD_LOOKUP; data = (DWORD_PTR) &link; } if (HtmlHelp(hwnd, help_path, command, data) == 0) MessageBox(NULL, help_path, "HtmlHelp Error", MB_OK); #else /* !WITH_HTMLHELP */ if (word == NULL) ShellExecute(NULL, "open", "http://gprolog.org/manual/html_node/index.html", NULL, ".", 0); else ShellExecute(NULL, "open", "http://gprolog.org/manual/html_node/gprolog-idx.html", NULL, ".", 0); #endif /* !WITH_HTMLHELP */ } static int Get_CHM_Help_Path(char *path) { char *p; int devel_mode; for (;;) { if ((p = Get_Prolog_Path(NULL, &devel_mode)) != NULL) break; if ((p = Get_Selected_Directory("Select the GNU Prolog directory", 0)) == NULL) return 0; Write_Windows_Registry("RootPath", REG_SZ, p, strlen(p)); } #ifdef DEBUG /* to force display + remove path (debug) */ MessageBox(NULL, p, "Prolog Root Path", MB_OK); Write_Windows_Registry("RootPath", REG_SZ, p, strlen(p)); // Write_Windows_Registry("RootPath", REG_SZ, "", 0); #endif if (devel_mode) { sprintf(path, "%s\\..\\doc\\gprolog.chm", p); if (access(path, F_OK) != 0) sprintf(path, "%s\\..\\..\\doc\\gprolog.chm", p); } else sprintf(path, "%s\\doc\\gprolog.chm", p); return 1; } /*<---------------------------------------------------------------------->*/ static void Add_Clipboard_To_Queue(void) { if (IsClipboardFormatAvailable(CF_TEXT) && OpenClipboard(hwndMain)) { HANDLE hClipData = GetClipboardData(CF_TEXT); if (hClipData) { char *str = (char *) GlobalLock(hClipData); if (str) Add_String_To_Queue(str, FIX_TAB | FIX_CR); GlobalUnlock(hClipData); } CloseClipboard(); } } static void Add_String_To_Queue(char *str, int mask_fix) { int c; EnterCriticalSection(&cs_queue); SetEvent(event_char_in_queue); while(*str) { c = *str++; if (c == '\r' && (mask_fix & FIX_CR)) continue; if (c == '\t' && (mask_fix & FIX_TAB)) c = KEY_ESC('\t'); if (c == '\\' && (mask_fix & FIX_BACKSLASH)) c = '/'; if (c == '\'' && (mask_fix & FIX_QUOTE)) Enqueue('\''); Enqueue(c); } LeaveCriticalSection(&cs_queue); SetEvent(event_char_in_queue); } static void Add_Char_To_Queue(int c) { EnterCriticalSection(&cs_queue); Enqueue(c); LeaveCriticalSection(&cs_queue); SetEvent(event_char_in_queue); } DLLEXPORT int W32GC_Kbd_Is_Not_Empty() { return !Queue_Is_Empty(); } DLLEXPORT int W32GC_Get_Char0() { int result; in_get_char = 1; Flush_Buffer(); /* synchronize output and posit */ last_is_read = 1; while (Queue_Is_Empty()) { WaitForSingleObject(event_char_in_queue, INFINITE); } EnterCriticalSection(&cs_queue); Dequeue(result); LeaveCriticalSection(&cs_queue); in_get_char = 0; last_is_read = 1; return result; } static void Set_Selection(int posit, int n) { SendMessage(hwndEditControl, EM_SETSEL, ec_start + posit, ec_start + posit + n); SendMessage(hwndEditControl, EM_SCROLLCARET, 0, 0); // ensure the caret is visible } static void Set_Caret_Position(int posit) { Set_Selection(posit, 0); } static int Move_Caret_To(int start_or_end) { int prompt_length = (fct_get_prompt_length) ? (*fct_get_prompt_length)() : 0; int c = (1 << 8) | VK_RIGHT; int count; start_or_end -= ec_start; /* < 0 if not in the current (last) line */ if (start_or_end < prompt_length) /* not in cur line or in the prompt: do nothing */ { // Set_Selection(posit, 0); // to prevent the move of the caret outside last line - comment if needed (commented because do not work well with double-click = word selection) return 0; } count = start_or_end - posit; if (count < 0) { count = -count; c = (1 << 8) | VK_LEFT; } while (count--) Add_Char_To_Queue(c); return 1; } static void Move_Caret_From_Mouse(int if_no_selection) { int start, end; SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &start, (LPARAM) &end); if (start != end) { if (copy_on_sel) SendMessage(hwndEditControl, WM_COPY, 0, 0); if (if_no_selection) return; } Move_Caret_To(start); } static int Delete_Selection(void) { int start, end; int count; if (dont_use_selection) /* is the selection reliable ? */ return 0; SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &start, (LPARAM) &end); count = end - start; if (count == 0 || !Move_Caret_To(start)) return 0; while (count--) Add_Char_To_Queue(KEY_CTRL('D')); return 1; } static void Display_Text(char *str, int n) { int end; while (n--) { switch (*str) { case '\r': break; case '\n': Flush_Buffer(); /* emit the line */ dont_use_selection = 1; SendMessage(hwndEditControl, EM_REPLACESEL, 0, (LPARAM) "\r\n"); SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &ec_start, (WPARAM) &end); dont_use_selection = 0; posit = 0; /* A NEW LINE begins here */ break; case '\b': /* really needed only if W32GC_Backd is not defined */ W32GC_Backd(1); /* else simply call it ! */ break; default: if (wr_buffer_ptr - wr_buffer >= sizeof(wr_buffer)) Flush_Buffer(); *wr_buffer_ptr++ = isprint(*str) ? *str : ' '; } str++; } if (!line_buffering) Flush_Buffer(); } static void Flush_Buffer(void) { int n; int max_size, text_size; int end; n = wr_buffer_ptr - wr_buffer; if (n > 0) { /* the n chararacters have to be written from ec_start + posit to ec_start + posit + n - 1 * it is important to replacesel (not to insert) because linedit will rewrite all next * chars in insert mode. Should be viewed as always in overwrite mode. * * Since we use the selection to replace chars, the selection should not be taken into * account by other threads. This is the reason we protect the code with dont_use_selection */ dont_use_selection = 1; // acquire selection max_size = SendMessage(hwndEditControl, EM_GETLIMITTEXT, 0, 0); text_size = SendMessage(hwndEditControl, WM_GETTEXTLENGTH, 0, 0); *wr_buffer_ptr = '\0'; end = ec_start + posit + n; // check if enough space (reserve room of "\r\n") if (end >= max_size) // else delete n and write n: nothing change ! { int line = SendMessage(hwndEditControl, EM_LINEFROMCHAR, end - max_size, 0); int line_index = SendMessage(hwndEditControl, EM_LINEINDEX, line + 1, 0); SendMessage(hwndEditControl, EM_SETSEL, 0, line_index); SendMessage(hwndEditControl, EM_REPLACESEL, 0, (LPARAM) wr_buffer_ptr); /* empty string to remove lines */ text_size = SendMessage(hwndEditControl, WM_GETTEXTLENGTH, 0, 0); SendMessage(hwndEditControl, EM_SETSEL, text_size, text_size); SendMessage(hwndEditControl, EM_GETSEL, (WPARAM) &ec_start, (WPARAM) &end); // re-init ec_start } SendMessage(hwndEditControl, EM_SETSEL, ec_start + posit, ec_start + posit + n); SendMessage(hwndEditControl, EM_REPLACESEL, 0, (LPARAM) wr_buffer); posit += n; } Set_Caret_Position(posit); wr_buffer_ptr = wr_buffer; last_is_read = 0; dont_use_selection = 0; // release selection } DLLEXPORT void W32GC_Set_Line_Buffering(int is_buffered) { line_buffering = is_buffered; if (!line_buffering) { Flush_Buffer(); CheckMenuItem(GetMenu(hwndMain), IDM_BUFFERING, MF_BYCOMMAND | MF_UNCHECKED); EnableMenuItem(GetMenu(hwndMain), IDM_FLUSH, MF_BYCOMMAND | MF_GRAYED); } else { CheckMenuItem(GetMenu(hwndMain), IDM_BUFFERING, MF_BYCOMMAND | MF_CHECKED); EnableMenuItem(GetMenu(hwndMain), IDM_FLUSH, MF_BYCOMMAND | MF_ENABLED); } } DLLEXPORT int W32GC_Get_Line_Buffering(void) { return line_buffering; } DLLEXPORT void W32GC_Flush(FILE *f) { Flush_Buffer(); } #ifdef DEBUG static int Console_Printf(char *format, ...) /* debug: display in the GUI */ { va_list arg_ptr; char buff[1024]; int ret; va_start(arg_ptr, format); ret = vsprintf(buff, format, arg_ptr); Display_Text(buff, strlen(buff)); va_end(arg_ptr); return ret; } #endif DLLEXPORT void W32GC_Put_Char(int c) { char c1 = c; Display_Text(&c1, 1); } DLLEXPORT void W32GC_Backd(int n) { if(n == 0) return; Flush_Buffer(); /* synchronize output and posit */ posit -= n; Set_Caret_Position(posit); } DLLEXPORT void W32GC_Forwd(int n) { if(n == 0) return; Flush_Buffer(); /* synchronize output and posit */ posit += n; Set_Caret_Position(posit); } DLLEXPORT void W32GC_Displ(int n, char *str) { Display_Text(str, n); } DLLEXPORT void W32GC_Displ_Str(char *str) { Display_Text(str, strlen(str)); } DLLEXPORT void W32GC_Erase(int n) { Flush_Buffer(); /* synchronize output and posit */ Set_Selection(posit, n); SendMessage(hwndEditControl, EM_REPLACESEL, 0, (LPARAM) ""); } DLLEXPORT void W32GC_Emit_Beep() { if (beep_on_error) PlaySound("SystemAsterisk", NULL, SND_ALIAS | SND_ASYNC); // Beep(440, 100); // old } DLLEXPORT void W32GC_Ins_Mode(int ins_mode) { } DLLEXPORT void W32GC_Screen_Size(int *row, int *col) { HDC hDC; RECT rc; int nHautCar, nLargCar; TEXTMETRIC textmetric; HFONT oldFont; hDC = GetDC(hwndEditControl); oldFont = SelectObject(hDC, hFont); GetTextMetrics(hDC, &textmetric); nHautCar = textmetric.tmExternalLeading + textmetric.tmHeight; nLargCar = textmetric.tmAveCharWidth; SelectObject(hDC, oldFont); ReleaseDC(hwndEditControl, hDC); GetClientRect(hwndEditControl, &rc); rc.bottom -= GetSystemMetrics(SM_CYHSCROLL); rc.right -= GetSystemMetrics(SM_CXVSCROLL); *col = rc.right / nLargCar; *row = rc.bottom / nHautCar; } DLLEXPORT int W32GC_Confirm_Box(char *title, char *msg) { UINT utype; if (IsIconic(hwndMain)) ShowWindow(hwndMain, SW_RESTORE); Flush_Buffer(); utype = MB_YESNO | MB_SETFOREGROUND | MB_ICONQUESTION; return (MessageBox(hwndMain, msg, title, utype) == IDYES); } DLLEXPORT void W32GC_Message_Box(char *title, char *msg, int type) { UINT utype; if (IsIconic(hwndMain)) ShowWindow(hwndMain, SW_RESTORE); Flush_Buffer(); utype = MB_OK | MB_SETFOREGROUND; if (type == 0) // error utype |= MB_ICONERROR; else if (type == 1) // warning utype |= MB_ICONWARNING; else if (type == 2) utype |= MB_ICONINFORMATION; // information else if (type == 3) utype |= MB_ICONQUESTION; // question MessageBox(hwndMain, msg, title,utype); } DLLEXPORT void W32GC_Exit_Process(int ret_val) { Flush_Buffer(); /* synchronize output and posit */ if (!last_is_read) W32GC_Message_Box("GNU Prolog", "Program terminated", 2); } static HWND Find_Text_Console_Handle(void) { HWND hwnd; char save_title[256]; char uniq_title[256]; GetConsoleTitle(save_title, sizeof(save_title)); sprintf(uniq_title, "%ld/%ld", GetTickCount(), GetCurrentProcessId()); SetConsoleTitle(uniq_title); Sleep(40); // wait to be sure the title is displayed hwnd = FindWindow(NULL, uniq_title); SetConsoleTitle(save_title); return hwnd; } /* Try to determine if launched from a command-line (if yes do not hide * the console) or as a separate screen (hide the console at start). * If cursor in 0,0 launched from a separate screen. */ static int Launched_From_Command_Line() { HANDLE h_stdout; CONSOLE_SCREEN_BUFFER_INFO csbi; int from_cmd_line; h_stdout = GetStdHandle(STD_OUTPUT_HANDLE); if (h_stdout == INVALID_HANDLE_VALUE) return TRUE; GetConsoleScreenBufferInfo(h_stdout, &csbi); from_cmd_line = (csbi.dwCursorPosition.X != 0 || csbi.dwCursorPosition.Y != 0); if (csbi.dwSize.X <= 0 || csbi.dwSize.Y <= 0) from_cmd_line = 1; return from_cmd_line; } static void Show_Text_Console(int show_console) { ShowWindow(hwnd_console, (show_console) ? SW_SHOW : SW_HIDE); SET_CHECKED_OPT(IDM_SHOW_CONSOLE, show_console); } �����������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/W32GUICons/w32_resource.h���������������������������������������������������������0000644�0001750�0001750�00000005761�13021324543�016355� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#ifndef IDC_STATIC #define IDC_STATIC (-1) #endif #define IDR_MENU 102 #define IDR_ACCEL 106 #define IDD_STACK_SIZES 109 #define IDI_ICON 113 #define IDC_STACK_DESC0 1000 #define IDC_STACK_DESC1 1001 #define IDC_DEF_SZ1 1002 #define IDC_ENV_VAR_NAME1 1003 #define IDC_DEF_SZ0 1004 #define IDC_ENV_SZ0 1005 #define IDC_ENV_SZ1 1006 #define IDC_ENV_VAR_NAME0 1007 #define IDC_REG_SZ1 1008 #define IDC_CUR_SZ0 1010 #define IDM_STACK_SIZES 40000 #define IDM_CONSULT 40001 #define IDM_CHDIR 40002 #define IDM_FILE_NAME 40003 #define IDM_EXIT 40004 #define IDM_COPY 40005 #define IDM_PASTE 40006 #define IDM_SELECT_ALL 40007 #define IDM_COPY_ON_SEL 40009 #define IDM_SAVE_OPTIONS 40011 #define IDM_INTERRUPT 40012 #define IDM_BEEP 40013 #define IDM_WRAP 40014 #define IDM_BUFFERING 40015 #define IDM_FLUSH 40016 #define IDM_SHOW_CONSOLE 40018 #define IDM_FONT 40019 #define IDM_MANUAL 40020 #define IDM_INDEX 40021 #define IDM_WEB 40022 #define IDM_ABOUT 40023 #define IDC_REG_SZ0 40026 #define IDC_STACK_DESC2 40027 #define IDC_DEF_SZ2 40028 #define IDC_ENV_VAR_NAME2 40029 #define IDC_ENV_SZ2 40030 #define IDC_REG_SZ2 40031 #define IDC_STACK_DESC3 40032 #define IDC_DEF_SZ3 40033 #define IDC_ENV_VAR_NAME3 40034 #define IDC_ENV_SZ3 40035 #define IDC_REG_SZ3 40036 #define IDC_CUR_SZ1 40037 #define IDC_CUR_SZ2 40038 #define IDC_CUR_SZ3 40039 #define IDC_FIXED_SIZES 40040 #define IDC_STACK_DESC4 40041 #define IDC_DEF_SZ4 40042 #define IDC_ENV_VAR_NAME4 40043 #define IDC_ENV_SZ4 40044 #define IDC_REG_SZ4 40045 #define IDC_CUR_SZ4 40046 ���������������gprolog-1.4.5/src/W32GUICons/Makefile.in������������������������������������������������������������0000644�0001750�0001750�00000001754�13021324543�015725� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������DLL_W32GUICONS = @DLL_W32GUICONS@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ CFLAGS_UNSIGNED_CHAR = @CFLAGS_UNSIGNED_CHAR@ RC = @RC@ RCFLAGS = @RCFLAGS@ LD = @LD@ LDFLAGS = @LDFLAGS@ LDGUILIBS = @LDGUILIBS@ DLLNAME = $(DLL_W32GUICONS) OBJDLL = w32_console@OBJ_SUFFIX@ RESDLL = w32_console.res .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .cpp .c .res .rc $(SUFFIXES) .cpp@OBJ_SUFFIX@: $(CC) -c $(CFLAGS) $(CFLAGS_UNSIGNED_CHAR) $*.cpp .c@OBJ_SUFFIX@: $(CC) -c $(CFLAGS) $(CFLAGS_UNSIGNED_CHAR) $*.c .rc.res: $(RC) $(RCFLAGS) @RC_OUT_NAME_OPT@$*.res $*.rc all: $(DLLNAME) w32gc_interf@OBJ_SUFFIX@ win_exe_icon.res $(DLLNAME): $(OBJDLL) $(RESDLL) $(LD) $(LDFLAGS) @LD_OUT_NAME_OPT@$(DLLNAME) $(OBJDLL) $(RESDLL) $(LDGUILIBS) @LD_DLL_OPT@ w32gc_interf@OBJ_SUFFIX@: w32gc_interf.h clean: rm -f *@OBJ_SUFFIX@ *.res *.RES $(DLLNAME) *.lib *.exp *.EXP *.idb *.pdb *.ilk distclean: clean ��������������������gprolog-1.4.5/src/BipsFD/���������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013221� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_infos.pl����������������������������������������������������������������0000644�0001750�0001750�00000007357�13021324543�015355� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_infos.pl * * Descr.: FD variable information management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_infos'. fd_vector_max(Max) :- set_bip_name(fd_vector_max, 1), '$call_c_test'('Pl_Fd_Vector_Max_1'(Max)). fd_set_vector_max(Max) :- set_bip_name(fd_set_vector_max, 1), '$call_c'('Pl_Fd_Set_Vector_Max_1'(Max)). fd_max_integer(Inf) :- set_bip_name(fd_max_integer, 1), '$call_c_test'('Pl_Fd_Max_Integer_1'(Inf)). fd_min(Fdv, Min) :- set_bip_name(fd_min, 2), '$call_c_test'('Pl_Fd_Min_2'(Fdv, Min)). fd_max(Fdv, Max) :- set_bip_name(fd_max, 2), '$call_c_test'('Pl_Fd_Max_2'(Fdv, Max)). fd_dom(Fdv, List) :- set_bip_name(fd_domain, 2), '$call_c_test'('Pl_Fd_Dom_2'(Fdv, List)). fd_size(Fdv, Size) :- set_bip_name(fd_size, 2), '$call_c_test'('Pl_Fd_Size_2'(Fdv, Size)). fd_has_extra_cstr(Fdv) :- set_bip_name(fd_has_extra_cstr, 1), '$call_c_test'('Pl_Fd_Has_Extra_Cstr_1'(Fdv)). fd_has_vector(Fdv) :- set_bip_name(fd_has_vector, 1), '$call_c_test'('Pl_Fd_Has_Vector_1'(Fdv)). fd_use_vector(Fdv) :- set_bip_name(fd_use_vector, 1), '$call_c_test'('Pl_Fd_Use_Vector_1'(Fdv)). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/t.pl�����������������������������������������������������������������������0000644�0001750�0001750�00000007421�13021324543�014021� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : development only * * File : t.pl * * Descr.: test - Prolog part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * GNU Prolog is free software; you can redistribute it and/or modify it * * under the terms of the GNU General Public License as published by the * * Free Software Foundation; either version 2, or any later version. * * * * GNU Prolog 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. * * 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. * *-------------------------------------------------------------------------*/ /* * You can put your own test code in these files (see DEVELOPMENT) * t.pl (Prolog part) * t_c.c (C part, eg. foreign code or C code used by your FD constraints) * t_fd.fd (FD constraint part) */ /* ind(X) :- fd_min(X, Min), X #= Min. ind(X) :- write(back(X)),nl, fd_min(X, Min), X #> Min, ind(X). */ /* %:- initialization(z1). z1:- fd_domain(X,[62,63,64,65,66,67,68,69,70]), fd_size(X,N), write(N), nl, halt. z0:- catch(z, _, write('TOO BIG\n')), halt. z:- Z = [A, B, C, D, E, F, G, H, I, J, K, L], fd_domain_bool(Z), % A ## B ## C. A ## B ## C ## D ## E ## F ## G ## H ## I ## J ## K ## L. */ /* works(L) :- L = [Z1, Z2], fd_domain(L, 10, 99), fd_prime(Z1), cross_sum(Z1, Z2), fd_labeling(L), is_square(Z2) . broken(L) :- L = [Z1, Z2], fd_domain(L, 10, 99), fd_prime(Z1), cross_sum(Z1, Z2), is_square(Z2), fd_labeling(L). cross_sum(X, X) :- X #< 10. cross_sum(X, Y) :- X #> 9, Y1 #= X rem 10, X1 #= X // 10, cross_sum(X1, Z), Y #= Z + Y1. is_square(1). is_square(4). is_square(9). is_square(X) :- Y #>= 1, Y #=< X, X #= Y * Y. */ /* sum([], 0):- statistics. sum([X|L], S1) :- sum(L, S), S1 #= X + S. sum1([], 0):- statistics. sum1([X|L], S1) :- S1 #= X + S, sum1(L, S). p :- length(BL, 10000), sum(BL, _BS), statistics. p1 :- length(BL, 10000), sum1(BL, _BS), statistics. dle(S1, S2, D, SY) :- fd_tell(dist_le(S1, S2, D, SY)). */ /* dle(X) :- fd_tell(foo(X)). */ /* bug(L) :- L=[P1,P2,P3,P4,P6,P7,P8,P9], fd_domain(L,[2,3,5,7]), % uncomment the following line and this works correctly % P2#=7, P4 * (100 * P3 + 10 * P2 + P1 ) #= 1000 * P9 + 100 * P8 + 10 * P7 + P6. */ /* q :- LD = [S, E, N, D], fd_domain(LD, 0, 4), fd_all_different(LD), S + 3 * E #= U, U #= 5 * N + D, % S=0, write(LD1), nl, % E=3, write(LD1), nl, % E=2 ne marche pas + remettre optim2 + SEH dans chkma % N=1, write(LD), nl, fd_labeling(LD), write(LD), nl. a:- q, fail ; true. :- initialization(a). */ �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_values.pl���������������������������������������������������������������0000644�0001750�0001750�00000016024�13021324543�015525� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_values.pl * * Descr.: FD variable values management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_values'. fd_domain(List, R) :- set_bip_name(fd_domain, 2), '$call_c_test'('Pl_Fd_Domain_2'(List, R)). fd_domain(List, L, U) :- set_bip_name(fd_domain, 3), '$call_c_test'('Pl_Fd_Domain_3'(List, L, U)). '$fd_domain'(X, L, U) :- % for fd builtins (exact errors) '$call_c_test'('Pl_Fd_Domain_Var_3'(X, L, U)). fd_domain_bool(List) :- set_bip_name(fd_domain_bool, 1), '$call_c_test'('Pl_Fd_Domain_3'(List, 0, 1)). fd_labeling(List) :- set_bip_name(fd_labeling, 1), '$fd_labeling'(List, []). fd_labelingff(List) :- set_bip_name(fd_labelingff, 1), '$fd_labeling'(List, [variable_method(first_fail)]). fd_labeling(List, Options) :- set_bip_name(fd_labeling, 2), '$fd_labeling'(List, Options). '$fd_labeling'(List, Options) :- '$set_labeling_defaults', '$get_labeling_options'(Options, Bckts), '$sys_var_read'(0, VarMethod), '$sys_var_read'(1, ValMethod), '$sys_var_read'(2, Reorder), '$fd_reset_labeling_backtracks', ( ( fd_var(List) ; integer(List) ) -> '$indomain'(List, ValMethod) ; '$check_list'(List), '$fd_labeling1'(List, VarMethod, ValMethod, Reorder) ), '$fd_get_labeling_backtracks'(Bckts). '$fd_reset_labeling_backtracks' :- '$fd_set_labeling_backtracks'(0). '$fd_set_labeling_backtracks'(Bckts) :- '$sys_var_write'(4, Bckts). % bckts counter '$fd_get_labeling_backtracks'(Bckts) :- '$sys_var_read'(4, Bckts). '$set_labeling_defaults' :- '$sys_var_write'(0, 0), '$sys_var_write'(1, 0), '$sys_var_write'(2, 1). '$get_labeling_options'(Options, Bckts) :- '$check_list'(Options), g_link('$backtracks', _), '$get_labeling_options1'(Options), g_read('$backtracks', Bckts). '$get_labeling_options1'([]). '$get_labeling_options1'([X|Options]) :- '$get_labeling_options2'(X), !, '$get_labeling_options1'(Options). '$get_labeling_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_labeling_options2'(variable_method(X)) :- '$check_nonvar'(X), % same order as in fd_values_c.c ( X = standard, '$sys_var_write'(0, 0) ; X = first_fail, '$sys_var_write'(0, 1) ; X = ff, '$sys_var_write'(0, 1) ; X = most_constrained, '$sys_var_write'(0, 2) ; X = smallest, '$sys_var_write'(0, 3) ; X = largest, '$sys_var_write'(0, 4) ; X = max_regret, '$sys_var_write'(0, 5) ; X = random, '$sys_var_write'(0, 6) ). '$get_labeling_options2'(value_method(X)) :- '$check_nonvar'(X), % same order as in fd_values_c.c ( X = min, '$sys_var_write'(1, 0) ; X = max, '$sys_var_write'(1, 1) ; X = random, '$sys_var_write'(1, 2) ; X = middle, '$sys_var_write'(1, 3) ; X = bisect, '$sys_var_write'(1, 4) ; X = limits, '$sys_var_write'(1, 5) ). '$get_labeling_options2'(reorder(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_write'(2, 0) ; X = true, '$sys_var_write'(2, 1) ). '$get_labeling_options2'(backtracks(Bckts)) :- % maybe check Bckts is var or integer ? g_link('$backtracks', Bckts). '$get_labeling_options2'(X) :- '$pl_err_domain'(fd_labeling_option, X). '$fd_labeling1'(List, 0, ValMethod, _) :- % standard !, '$fd_labeling_std'(List, ValMethod). '$fd_labeling1'(List, VarMethod, ValMethod, Reorder) :- '$fd_sel_array_from_list'(List, SelArray), '$fd_labeling_mth'(SelArray, VarMethod, ValMethod, Reorder). '$fd_labeling_std'([], _). '$fd_labeling_std'([X|List], ValMethod) :- '$indomain'(X, ValMethod), '$fd_labeling_std'(List, ValMethod). '$fd_labeling_mth'(SelArray, VarMethod, ValMethod, Reorder) :- '$fd_sel_array_pick_var'(SelArray, VarMethod, Reorder, X), !, '$indomain'(X, ValMethod), '$fd_labeling_mth'(SelArray, VarMethod, ValMethod, Reorder). '$fd_labeling_mth'(_, _, _, _). '$fd_sel_array_from_list'(List, SelArray) :- '$call_c_test'('Pl_Fd_Sel_Array_From_List_2'(List, SelArray)). '$fd_sel_array_pick_var'(SelArray, Method, Reorder, Fdv) :- '$call_c_test'('Pl_Fd_Sel_Array_Pick_Var_4'(SelArray, Method, Reorder, Fdv)). '$indomain'(X, ValMethod) :- '$call_c_test'('Pl_Indomain_2'(X, ValMethod)). '$indomain_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Indomain_Alt_0'). '$extra_cstr_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Extra_Cstr_Alt_0'). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_bool_fd.fd��������������������������������������������������������������0000644�0001750�0001750�00000052476�13021324543�015623� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_bool_fd.fd * * Descr.: boolean and meta-constraint predicate management - FD part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ %{ #define not(x) (1 - (x)) #define and(x, y) ((x) & (y)) #define or(x, y) ((x) | (y)) #define xor(x, y) ((x) ^ (y)) #define eqv(x, y) (not(xor(x, y))) #define impl(x, y) (not(x) | (y)) %} /*-------------------------------------------------------------------------* * How are written the boolean primitive constraints. * * * * I- When a variable X can only be determined when all other variables are* * instantiated, we use: * * * * X in { true_formula } * * * * where true_formula is the formula when X is true. * * The value of the other variables are get with val() to avoid useless * * reevaluation of the constraint. * * * * Ex: #~ X <=> B * * * * var true_formula X B * * --- ------------ --- * * B ~X 0 1 * * X ~B 1 0 * * * * X in { not(val(B)) } * * B in { not(val(X)) } * * * * * * II- When a variable X can be determined thanks to a subset of other * * variables, we use: * * * * X in true_formula .. not_false_formula * * * * where true_formula is the formula when X is true and not_false_formula * * is the negation of the formula when X is false. To find when a variable * * is true (resp. false) look at the truth table of THAT VARIABLE (the one * * determining that variable from all combinations of the other variables).* * Combinations when the variable can be 0 or 1 (undefined) are ignored. * * * * NB: for functions, true_formula = not_false_formula but it is not the * * case for surjective mappings. The value of the other variables are get * * with min() in the lower bound of the constraint (or inside a not in the * * upper bound and with max in the upper bound of the constraint (or inside* * a not in the lower bound). * * * * Ex: X ==> Y <=> B * * * * var true_formula false_formula not_false_formula X Y B * * --- ------------ ------------- ----------------- ----- * * B ~X \/ Y X /\ ~Y ~X \/ Y 0 0 1 * * X ~B B /\ ~Y ~B \/ Y 0 1 1 * * Y X /\ B ~B B 1 0 0 * * 1 1 1 * * B in or(not(max(X)), min(Y)) .. or(not(min(X)), max(Y)) * * X in not(max(B)) .. or(not(min(B)), max(Y)) * * Y in and(min(B), min(X)) .. max(B) * * * * The obtained formula is simplified if possible. For instance in * * X /\ Y <=> B the true_formula for X is Y /\ B, However, B ==> Y, then * * the formula becomes: B (since if B is false, Y /\ B is false and if B is* * true, Y is also true (since B==>Y) then Y /\ B is also true). * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * NOT * * * *-------------------------------------------------------------------------*/ pl_not_x_eq_b(fdv X, fdv B) { start X in { not(val(B)) } start B in { not(val(X)) } } /*-------------------------------------------------------------------------* * EQUIVALENT * * * *-------------------------------------------------------------------------*/ pl_x_equiv_y_eq_b(fdv X, fdv Y, fdv B) { start B in { eqv(val(X), val(Y)) } start X in { eqv(val(Y), val(B)) } start Y in { eqv(val(X), val(B)) } } /*-------------------------------------------------------------------------* * NOT EQUIVALENT (ie. XOR) * * * *-------------------------------------------------------------------------*/ pl_x_nequiv_y_eq_b(fdv X, fdv Y, fdv B) { start B in { xor(val(X), val(Y)) } start X in { xor(val(Y), val(B)) } start Y in { xor(val(X), val(B)) } } /*-------------------------------------------------------------------------* * IMPLY * * * *-------------------------------------------------------------------------*/ pl_x_imply_y_eq_b(fdv X, fdv Y, fdv B) { start B in or(not(max(X)), min(Y)) .. or(not(min(X)), max(Y)) start X in not(max(B)) .. or(not(min(B)), max(Y)) start Y in and(min(B), min(X)) .. max(B) } pl_x_imply_y_eq_1(fdv X, fdv Y) { start X in 0 .. max(Y) start Y in min(X) .. 1 } /*-------------------------------------------------------------------------* * NOT IMLPY * * * *-------------------------------------------------------------------------*/ pl_x_nimply_y_eq_b(fdv X, fdv Y, fdv B) { start B in and(min(X), not(max(Y))) .. and(max(X), not(min(Y))) start X in min(B) .. or(max(B), max(Y)) start Y in and(not(max(B)), min(X)) .. not(min(B)) } /*-------------------------------------------------------------------------* * AND * * * *-------------------------------------------------------------------------*/ pl_x_and_y_eq_b(fdv X, fdv Y, fdv B) { start B in and(min(X), min(Y)) .. and(max(X), max(Y)) start X in min(B) .. or(max(B), not(min(Y))) start Y in min(B) .. or(max(B), not(min(X))) } pl_x_and_y_eq_0(fdv X, fdv Y) { start X in 0 .. not(min(Y)) start Y in 0 .. not(min(X)) } /*-------------------------------------------------------------------------* * NOT AND * * * *-------------------------------------------------------------------------*/ pl_x_nand_y_eq_b(fdv X, fdv Y, fdv B) { start B in or(not(max(X)), not(max(Y))) .. or(not(min(X)), not(min(Y))) start X in not(max(B)) .. or(not(min(B)), not(min(Y))) start Y in not(max(B)) .. or(not(min(B)), not(min(X))) } /*-------------------------------------------------------------------------* * OR * * * *-------------------------------------------------------------------------*/ pl_x_or_y_eq_b(fdv X, fdv Y, fdv B) { start B in or(min(X), min(Y)) .. or(max(X), max(Y)) start X in and(min(B), not(max(Y))) .. max(B) start Y in and(min(B), not(max(X))) .. max(B) } pl_x_or_y_eq_1(fdv X, fdv Y) { start X in not(max(Y)) .. 1 start Y in not(max(X)) .. 1 } /*-------------------------------------------------------------------------* * NOR * * * *-------------------------------------------------------------------------*/ pl_x_nor_y_eq_b(fdv X, fdv Y, fdv B) { start B in and(not(max(X)), not(max(Y))) .. and(not(min(X)), not(min(Y))) start X in and(not(max(B)), not(max(Y))) .. not(min(B)) start Y in and(not(max(B)), not(max(X))) .. not(min(B)) } /*-------------------------------------------------------------------------* * TRUTH OF EQUAL (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_truth_x_eq_c(fdv X, int C, fdv B) { wait_switch case max(B) == 0 start X in ~{ C } case min(B) == 1 start X in { C } case min(X) > C || max(X) < C start B in { 0 } case min(X) == C && max(X) == C start B in { 1 } } pl_truth_x_eq_y(fdv X, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in ~{ val(Y) } start Y in ~{ val(X) } case min(B) == 1 start X in min(Y) .. max(Y) start Y in min(X) .. max(X) case min(X) > max(Y) || max(X) < min(Y) start B in { 0 } case min(X) == max(Y) && max(X) == min(Y) start B in { 1 } } pl_truth_x_plus_c_eq_y(fdv X, int C, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in ~{ val(Y)-C } start Y in ~{ val(X) + C } case min(B) == 1 start X in min(Y)-C .. max(Y)-C start Y in min(X) + C .. max(X) + C case min(X) + C > max(Y) || max(X) + C < min(Y) start B in { 0 } case min(X) + C == max(Y) && max(X) + C == min(Y) start B in { 1 } } /*------------* * Full AC * *------------*/ pl_truth_x_eq_c_F(fdv X, int C, fdv B) { wait_switch case max(B) == 0 start X in ~{ C } case min(B) == 1 start X in { C } case Pl_Range_Test_Value(dom(X), C) == 0 start B in { 0 } case min(X) == C && max(X) == C start B in { 1 } } pl_truth_x_eq_y_F(fdv X, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in ~{ val(Y) } start Y in ~{ val(X) } case min(B) == 1 start X in dom(Y) start Y in dom(X) case Pl_Range_Test_Null_Inter(dom(X), dom(Y)) start B in { 0 } case min(X) == max(Y) && max(X) == min(Y) start B in { 1 } } pl_truth_x_plus_c_eq_y_F(fdv X, int C, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in ~{ val(Y)-C } start Y in ~{ val(X) + C } case min(B) == 1 start X in dom(Y) - C start Y in dom(X) + C case Pl_Range_Test_Null_Inter(dom(X) + C, dom(Y)) start B in { 0 } case min(X) + C == max(Y) && max(X) + C == min(Y) start B in { 1 } } /*-------------------------------------------------------------------------* * TRUTH OF DIFFERENT (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_truth_x_neq_c(fdv X, int C, fdv B) { wait_switch case max(B) == 0 start X in { C } case min(B) == 1 start X in ~{ C } case min(X) == C && max(X) == C start B in { 0 } case min(X) > C || max(X) < C start B in { 1 } } pl_truth_x_neq_y(fdv X, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in min(Y) .. max(Y) start Y in min(X) .. max(X) case min(B) == 1 start X in ~{ val(Y) } start Y in ~{ val(X) } case min(X) == max(Y) && max(X) == min(Y) start B in { 0 } case min(X) > max(Y) || max(X) < min(Y) start B in { 1 } } pl_truth_x_plus_c_neq_y(fdv X, int C, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in min(Y)-C .. max(Y)-C start Y in min(X) + C .. max(X) + C case min(B) == 1 start X in ~{ val(Y)-C } start Y in ~{ val(X) + C } case min(X) + C == max(Y) && max(X) + C == min(Y) start B in { 0 } case min(X) + C > max(Y) || max(X) + C < min(Y) start B in { 1 } } /*------------* * Full AC * *------------*/ pl_truth_x_neq_c_F(fdv X, int C, fdv B) { wait_switch case max(B) == 0 start X in { C } case min(B) == 1 start X in ~{ C } case min(X) == C && max(X) == C start B in { 0 } case Pl_Range_Test_Value(dom(X), C) == 0 start B in { 1 } } pl_truth_x_neq_y_F(fdv X, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in dom(Y) start Y in dom(X) case min(B) == 1 start X in ~{ val(Y) } start Y in ~{ val(X) } case min(X) == max(Y) && max(X) == min(Y) start B in { 0 } case Pl_Range_Test_Null_Inter(dom(X), dom(Y)) start B in { 1 } } pl_truth_x_plus_c_neq_y_F(fdv X, int C, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in dom(Y) - C start Y in dom(X) + C case min(B) == 1 start X in ~{ val(Y)-C } start Y in ~{ val(X) + C } case min(X) + C == max(Y) && max(X) + C == min(Y) start B in { 0 } case Pl_Range_Test_Null_Inter(dom(X) + C, dom(Y)) start B in { 1 } } /*-------------------------------------------------------------------------* * TRUTH OF LESS THAN (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_truth_x_lt_y(fdv X, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in min(Y) .. max_integer start Y in 0 .. max(X) case min(B) == 1 start X in 0 .. max(Y)-1 start Y in min(X)+1 .. max_integer case min(X) >= max(Y) start B in { 0 } case max(X) < min(Y) start B in { 1 } } /*-------------------------------------------------------------------------* * TRUTH OF LESS THAN OR EQUAL TO (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_truth_x_lte_c(fdv X, int C, fdv B) { wait_switch case max(B) == 0 start X in C+1 .. max_integer case min(B) == 1 start X in 0 .. C case min(X) > C start B in { 0 } case max(X) <= C start B in { 1 } } pl_truth_x_lte_y(fdv X, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in min(Y)+1 .. max_integer start Y in 0 .. max(X)-1 case min(B) == 1 start X in 0 .. max(Y) start Y in min(X) .. max_integer case min(X) > max(Y) start B in { 0 } case max(X) <= min(Y) start B in { 1 } } pl_truth_x_plus_c_lte_y(fdv X, int C, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in min(Y)-C+1 .. max_integer start Y in 0 .. max(X) + C-1 case min(B) == 1 start X in 0 .. max(Y)-C start Y in min(X) + C .. max_integer case min(X) + C > max(Y) start B in { 0 } case max(X) + C <= min(Y) start B in { 1 } } /*-------------------------------------------------------------------------* * TRUTH OF GREATER THAN OR EQUAL TO (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_truth_x_gte_c(fdv X, int C, fdv B) { wait_switch case max(B) == 0 start X in 0 .. C-1 case min(B) == 1 start X in C .. max_integer case max(X)<C start B in { 0 } case min(X) >= C start B in { 1 } } pl_truth_x_plus_c_gte_y(fdv X, int C, fdv Y, fdv B) { wait_switch case max(B) == 0 start X in 0 .. max(Y)-C-1 start Y in min(X) + C+1 .. max_integer case min(B) == 1 start X in min(Y)-C .. max_integer start Y in 0 .. max(X) + C case max(X) + C<min(Y) start B in { 0 } case min(X) + C >= max(Y) start B in { 1 } } pl_truth_x_in_l_u(fdv X, int L, int U, fdv B) { wait_switch case max(B) == 0 start X in ~ (L .. U) case min(B) == 1 start X in L .. U case min(X) > U || max(X) < L start B in { 0 } case min(X) >= L && max(X) <= U start B in { 1 } } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_prime_fd.fd�������������������������������������������������������������0000644�0001750�0001750�00000005515�13021324543�015774� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_prime_fd.fd * * Descr.: Prime constraint management - FD part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ pl_prime_x(fdv X) { start X in Pl_Prime_Range(0) } pl_not_prime_x(fdv X) { start X in Pl_Not_Prime_Range(0) } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/bips_fd.h������������������������������������������������������������������0000644�0001750�0001750�00000005405�13021324543�015000� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : bips_fd.h * * Descr.: general header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "math_supp.h" #include "oper_supp.h" �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_math_c.c����������������������������������������������������������������0000644�0001750�0001750�00000021572�13021324543�015274� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_math_c.c * * Descr.: mathematical predicate management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_FD_SET_FULL_AC_FLAG_1 * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Set_Full_Ac_Flag_1(WamWord full_ac_word) { pl_full_ac = Pl_Rd_Integer(full_ac_word); } /*-------------------------------------------------------------------------* * PL_FD_EQ_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Eq_2(WamWord le_word, WamWord re_word) { int mask; WamWord l_word, r_word; PlLong c; #ifdef DEBUG cur_op = (pl_full_ac) ? "#=#" : "#="; #endif if (!Pl_Load_Left_Right(TRUE, le_word, re_word, &mask, &c, &l_word, &r_word)) return FALSE; switch (mask) { case MASK_EMPTY: if (c != 0) return FALSE; goto term_load; case MASK_LEFT: if (c > 0) return FALSE; PRIM_CSTR_2(pl_x_eq_c, l_word, Tag_INT(-c)); goto term_load; case MASK_RIGHT: if (c < 0) return FALSE; PRIM_CSTR_2(pl_x_eq_c, r_word, Tag_INT(c)); goto term_load; } if (c > 0) { MATH_CSTR_3(pl_x_plus_c_eq_y, l_word, Tag_INT(c), r_word); goto term_load; } if (c < 0) { MATH_CSTR_3(pl_x_plus_c_eq_y, r_word, Tag_INT(-c), l_word); goto term_load; } /* if c == 0 nothing to do since preference via pref_load_word */ term_load: return Pl_Term_Math_Loading(l_word, r_word); } /*-------------------------------------------------------------------------* * PL_FD_NEQ_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Neq_2(WamWord le_word, WamWord re_word) { int mask; WamWord l_word, r_word; PlLong c; #ifdef DEBUG cur_op = (pl_full_ac) ? "#\\=#" : "#\\="; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word)) return FALSE; switch (mask) { case MASK_EMPTY: if (c == 0) return FALSE; goto term_load; case MASK_LEFT: if (c > 0) { Pl_Fd_Prolog_To_Fd_Var(l_word, TRUE); goto term_load; } PRIM_CSTR_2(pl_x_neq_c, l_word, Tag_INT(-c)); goto term_load; case MASK_RIGHT: if (c < 0) { Pl_Fd_Prolog_To_Fd_Var(r_word, TRUE); goto term_load; } PRIM_CSTR_2(pl_x_neq_c, r_word, Tag_INT(c)); goto term_load; } if (c > 0) { PRIM_CSTR_3(pl_x_plus_c_neq_y, l_word, Tag_INT(c), r_word); goto term_load; } if (c < 0) { PRIM_CSTR_3(pl_x_plus_c_neq_y, r_word, Tag_INT(-c), l_word); goto term_load; } PRIM_CSTR_2(pl_x_neq_y, l_word, r_word); term_load: return Pl_Term_Math_Loading(l_word, r_word); } /*-------------------------------------------------------------------------* * PL_FD_LT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Lt_2(WamWord le_word, WamWord re_word) { int mask; WamWord l_word, r_word; PlLong c; #ifdef DEBUG cur_op = (pl_full_ac) ? "#<#" : "#<"; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word)) return FALSE; switch (mask) { case MASK_EMPTY: if (c >= 0) return FALSE; goto term_load; case MASK_LEFT: if (c >= 0) return FALSE; PRIM_CSTR_2(pl_x_lte_c, l_word, Tag_INT(-c - 1)); goto term_load; case MASK_RIGHT: if (c < 0) { Pl_Fd_Prolog_To_Fd_Var(r_word, TRUE); goto term_load; } PRIM_CSTR_2(pl_x_gte_c, r_word, Tag_INT(c + 1)); goto term_load; } if (c > 0) { PRIM_CSTR_3(pl_x_plus_c_lte_y, l_word, Tag_INT(c + 1), r_word); goto term_load; } if (c < 0) { PRIM_CSTR_3(pl_x_plus_c_gte_y, r_word, Tag_INT(-c - 1), l_word); goto term_load; } PRIM_CSTR_2(pl_x_lt_y, l_word, r_word); term_load: return Pl_Term_Math_Loading(l_word, r_word); } /*-------------------------------------------------------------------------* * PL_FD_LTE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Lte_2(WamWord le_word, WamWord re_word) { int mask; WamWord l_word, r_word; PlLong c; #ifdef DEBUG cur_op = (pl_full_ac) ? "#=<#" : "#=<"; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word)) return FALSE; switch (mask) { case MASK_EMPTY: if (c > 0) return FALSE; goto term_load; case MASK_LEFT: if (c > 0) return FALSE; PRIM_CSTR_2(pl_x_lte_c, l_word, Tag_INT(-c)); goto term_load; case MASK_RIGHT: if (c <= 0) { Pl_Fd_Prolog_To_Fd_Var(r_word, TRUE); goto term_load; } PRIM_CSTR_2(pl_x_gte_c, r_word, Tag_INT(c)); goto term_load; } if (c > 0) { PRIM_CSTR_3(pl_x_plus_c_lte_y, l_word, Tag_INT(c), r_word); goto term_load; } if (c < 0) { PRIM_CSTR_3(pl_x_plus_c_gte_y, r_word, Tag_INT(-c), l_word); goto term_load; } PRIM_CSTR_2(pl_x_lte_y, l_word, r_word); term_load: return Pl_Term_Math_Loading(l_word, r_word); } ��������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_bool.pl�����������������������������������������������������������������0000644�0001750�0001750�00000011275�13021324543�015164� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_bool.pl * * Descr.: boolean and Meta-constraint predicate management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_bool'. '$truth_of'(Cstr, B) :- '$call_c_test'('Pl_Fd_Bool_Meta_3'(Cstr, B, 1)). #\ LE :- set_bip_name(#\, 1), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, 0, 0)). LE #<=> RE :- set_bip_name(#<=>, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 1)). LE #\<=> RE :- set_bip_name(#\<=>, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 2)). LE ## RE :- set_bip_name(#, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 2)). LE #==> RE :- set_bip_name(#==>, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 3)). LE #\==> RE :- set_bip_name(#\==>, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 4)). LE #/\ RE :- set_bip_name(#/\, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 5)). LE #\/\ RE :- set_bip_name(#\/\, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 6)). LE #\/ RE :- set_bip_name(#\/, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 7)). LE #\\/ RE :- set_bip_name(#\\/, 2), '$call_c_test'('Pl_Fd_Bool_Meta_3'(LE, RE, 8)). % Reified interval fd_reified_in(X, L, U, B) :- set_bip_name(fd_reified_in, 4), '$call_c_test'('Pl_Fd_Reified_In'(X, L, U, B)). % Symbolic boolean constraints fd_cardinality(List, Count) :- fd_max_integer(Inf), set_bip_name(fd_cardinality, 2), '$fd_domain'(Count, 0, Inf), % to check type of Count '$fd_cardinality'(List, Count). '$fd_cardinality'(List, Count) :- '$check_list'(List), '$fd_cardinality1'(List, Count). '$fd_cardinality1'([], 0). '$fd_cardinality1'([C|List], Count1) :- '$fd_cardinality1'(List, Count), '$truth_of'(C, B), Count1 #= Count + B. fd_cardinality(L, List, U) :- set_bip_name(fd_cardinality, 3), '$fd_domain'(Count, L, U), '$fd_cardinality'(List, Count). fd_at_least_one(List) :- set_bip_name(fd_at_least_one, 1), '$fd_cardinality'(List, Count), Count #>= 1 . fd_at_most_one(List) :- set_bip_name(fd_at_most_one, 1), '$fd_cardinality'(List, Count), Count #=< 1 . fd_only_one(List) :- set_bip_name(fd_only_one, 1), '$fd_cardinality'(List, 1). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/t_c.c����������������������������������������������������������������������0000644�0001750�0001750�00000006500�13021324543�014127� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : development only * * File : t_c.c * * Descr.: test - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * GNU Prolog is free software; you can redistribute it and/or modify it * * under the terms of the GNU General Public License as published by the * * Free Software Foundation; either version 2, or any later version. * * * * GNU Prolog 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. * * 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. * *-------------------------------------------------------------------------*/ /* * You can put your own test code in these files (see DEVELOPMENT) * t.pl (Prolog part) * t_c.c (C part, eg. foreign code or C code used by your FD constraints) * t_fd.fd (FD constraint part) */ #include <stdio.h> #include <stdlib.h> #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * * * * *-------------------------------------------------------------------------*/ #if 0 void Dist_LE(Range *s1, long s2, long d, long size_y) { int x1 = s2 / size_y; int y1 = s2 % size_y; int x2, y2, n; int size_x = size_y; Vector_Allocate(s1->vec); Pl_Vector_Empty(s1->vec); for(x2 = x1 - d; x2 <= x1 + d; x2++) { if (x2 < 0) continue; if (x2 >= size_x) break; n = d - abs(x1 - x2); for(y2 = y1 - n; y2 <= y1 + n; y2++) if (y2 >= 0 && y2 < size_y) Vector_Set_Value(s1->vec, x2 * size_y + y2); } Pl_Range_From_Vector(s1); } #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/math_supp.h����������������������������������������������������������������0000644�0001750�0001750�00000027063�13021324543�015376� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : math_supp.h * * Descr.: mathematical support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define MASK_EMPTY 0 #define MASK_LEFT 1 #define MASK_RIGHT 2 #if 0 #define DEBUG #endif /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef MATH_SUPP_FILE Bool pl_full_ac; #ifdef DEBUG char *cur_op; #endif #else #ifdef DEBUG char *cur_op; #endif extern Bool pl_full_ac; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ Bool Pl_Load_Left_Right(Bool optim_eq, WamWord le_word, WamWord re_word, int *mask, PlLong *c, WamWord *l_word, WamWord *r_word); Bool Pl_Term_Math_Loading(WamWord l_word, WamWord r_word); Bool Pl_Fd_Math_Unify_X_Y(WamWord x, WamWord y); #ifdef DEBUG void Debug_Display(char *fct, int n, ...); #endif /* defined in fd_math_fd.fd */ Bool pl_x_eq_c(WamWord x, WamWord c); /* in math_supp.c */ Bool pl_x_eq_y(WamWord x, WamWord y); Bool pl_x_plus_c_eq_y(WamWord x, WamWord c, WamWord y); Bool pl_x_eq_y_F(WamWord x, WamWord y); Bool pl_x_plus_c_eq_y_F(WamWord x, WamWord c, WamWord y); Bool pl_x_neq_c(WamWord x, WamWord c); Bool pl_x_neq_y(WamWord x, WamWord y); Bool pl_x_plus_c_neq_y(WamWord x, WamWord c, WamWord y); Bool pl_x_lt_y(WamWord x, WamWord y); Bool pl_x_lte_c(WamWord x, WamWord c); Bool pl_x_lte_y(WamWord x, WamWord y); Bool pl_x_plus_c_lte_y(WamWord x, WamWord c, WamWord y); Bool pl_x_gte_c(WamWord x, WamWord c); Bool pl_x_plus_c_gte_y(WamWord x, WamWord c, WamWord y); Bool pl_ax_eq_y(WamWord a, WamWord x, WamWord y); Bool pl_x_plus_y_eq_z(WamWord x, WamWord y, WamWord z); Bool pl_ax_plus_y_eq_z(WamWord a, WamWord x, WamWord y, WamWord z); Bool pl_ax_plus_by_eq_z(WamWord a, WamWord x, WamWord b, WamWord y, WamWord z); Bool pl_x_plus_y_plus_z_eq_t(WamWord x, WamWord y, WamWord z, WamWord t); Bool pl_ax_plus_y_plus_z_eq_t(WamWord a, WamWord x, WamWord y, WamWord z, WamWord t); Bool pl_ax_plus_by_plus_z_eq_t(WamWord a, WamWord x, WamWord b, WamWord y, WamWord z, WamWord t); Bool pl_ax_eq_y_F(WamWord a, WamWord x, WamWord y); Bool pl_x_plus_y_eq_z_F(WamWord x, WamWord y, WamWord z); Bool pl_ax_plus_y_eq_z_F(WamWord a, WamWord x, WamWord y, WamWord z); Bool pl_ax_plus_by_eq_z_F(WamWord a, WamWord x, WamWord b, WamWord y, WamWord z); Bool pl_x_plus_y_plus_z_eq_t_F(WamWord x, WamWord y, WamWord z, WamWord t); Bool pl_ax_plus_y_plus_z_eq_t_F(WamWord a, WamWord x, WamWord y, WamWord z, WamWord t); Bool pl_ax_plus_by_plus_z_eq_t_F(WamWord a, WamWord x, WamWord b, WamWord y, WamWord z, WamWord t); Bool pl_zero_power_n_eq_y(WamWord n, WamWord y); Bool pl_a_power_n_eq_y(WamWord a, WamWord n, WamWord y); Bool pl_x_power_a_eq_y(WamWord x, WamWord a, WamWord y); Bool pl_x2_eq_y(WamWord x, WamWord y); Bool pl_xy_eq_z(WamWord x, WamWord y, WamWord z); Bool pl_a_power_n_eq_y_F(WamWord a, WamWord n, WamWord y); Bool pl_x_power_a_eq_y_F(WamWord x, WamWord a, WamWord y); Bool pl_x2_eq_y_F(WamWord x, WamWord y); Bool pl_xy_eq_z_F(WamWord x, WamWord y, WamWord z); Bool pl_min_x_a_eq_z(WamWord x, WamWord a, WamWord z); Bool pl_min_x_y_eq_z(WamWord x, WamWord y, WamWord z); Bool pl_min_x_a_eq_z_F(WamWord x, WamWord a, WamWord z); Bool pl_min_x_y_eq_z_F(WamWord x, WamWord y, WamWord z); Bool pl_max_x_a_eq_z(WamWord x, WamWord a, WamWord z); Bool pl_max_x_y_eq_z(WamWord x, WamWord y, WamWord z); Bool pl_max_x_a_eq_z_F(WamWord x, WamWord a, WamWord z); Bool pl_max_x_y_eq_z_F(WamWord x, WamWord y, WamWord z); Bool pl_abs_x_minus_a_eq_z(WamWord x, WamWord a, WamWord z); Bool pl_abs_x_minus_y_eq_z(WamWord x, WamWord y, WamWord z); Bool pl_abs_x_minus_a_eq_z_F(WamWord x, WamWord a, WamWord z); Bool pl_abs_x_minus_y_eq_z_F(WamWord x, WamWord y, WamWord z); Bool pl_quot_rem_a_y_r_eq_z(WamWord a, WamWord y, WamWord r, WamWord z); Bool pl_quot_rem_x_a_r_eq_z(WamWord x, WamWord a, WamWord r, WamWord z); Bool pl_quot_rem_x_y_r_eq_z(WamWord x, WamWord y, WamWord r, WamWord z); Bool pl_quot_rem_a_y_r_eq_z_F(WamWord a, WamWord y, WamWord r, WamWord z); Bool pl_quot_rem_x_a_r_eq_z_F(WamWord x, WamWord a, WamWord r, WamWord z); Bool pl_quot_rem_x_y_r_eq_z_F(WamWord x, WamWord y, WamWord r, WamWord z); /* defined in fd_bool_fd.fd */ Bool pl_not_x_eq_b(WamWord x, WamWord b); Bool pl_x_equiv_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_nequiv_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_imply_y_eq_1(WamWord x, WamWord y); Bool pl_x_imply_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_nimply_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_and_y_eq_0(WamWord x, WamWord y); Bool pl_x_and_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_nand_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_or_y_eq_1(WamWord x, WamWord y); Bool pl_x_or_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_x_nor_y_eq_b(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_eq_c(WamWord x, WamWord c, WamWord b); Bool pl_truth_x_eq_y(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_plus_c_eq_y(WamWord x, WamWord c, WamWord y, WamWord b); Bool pl_truth_x_eq_c_F(WamWord x, WamWord c, WamWord b); Bool pl_truth_x_eq_y_F(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_plus_c_eq_y_F(WamWord x, WamWord c, WamWord y, WamWord b); Bool pl_truth_x_neq_c(WamWord x, WamWord c, WamWord b); Bool pl_truth_x_neq_y(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_plus_c_neq_y(WamWord x, WamWord c, WamWord y, WamWord b); Bool pl_truth_x_neq_c_F(WamWord x, WamWord c, WamWord b); Bool pl_truth_x_neq_y_F(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_plus_c_neq_y_F(WamWord x, WamWord c, WamWord y, WamWord b); Bool pl_truth_x_lt_y(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_lte_c(WamWord x, WamWord c, WamWord b); Bool pl_truth_x_lte_y(WamWord x, WamWord y, WamWord b); Bool pl_truth_x_plus_c_lte_y(WamWord x, WamWord c, WamWord y, WamWord b); Bool pl_truth_x_gte_c(WamWord x, WamWord c, WamWord b); Bool pl_truth_x_plus_c_gte_y(WamWord x, WamWord c, WamWord y, WamWord b); Bool pl_truth_x_in_l_u(WamWord x, WamWord l, WamWord u, WamWord b); #ifdef DEBUG #define DEBUG_2(f, a1, a2) Debug_Display(#f, 2, a1, a2) #define DEBUG_3(f, a1, a2, a3) Debug_Display(#f, 3, a1, a2, a3) #define DEBUG_4(f, a1, a2, a3, a4) Debug_Display(#f, 4, a1, a2, a3, a4) #define DEBUG_5(f, a1, a2, a3, a4, a5) Debug_Display(#f, 5, a1, a2, a3, a4, a5) #define DEBUG_6(f, a1, a2, a3, a4, a5, a6) Debug_Display(#f, 6, a1, a2, a3, a4, a5, a6) #else #define DEBUG_2(f, a1, a2) #define DEBUG_3(f, a1, a2, a3) #define DEBUG_4(f, a1, a2, a3, a4) #define DEBUG_5(f, a1, a2, a3, a4, a5) #define DEBUG_6(f, a1, a2, a3, a4, a5, a6) #endif #define PRIM_CSTR_2(f, a1, a2) \ do \ { \ DEBUG_2(f, a1, a2); \ if (!f(a1, a2)) \ return FALSE; \ } \ while (0) #define PRIM_CSTR_3(f, a1, a2, a3) \ do \ { \ DEBUG_3(f, a1, a2, a3); \ if (!f(a1, a2, a3)) \ return FALSE; \ } \ while (0) #define PRIM_CSTR_4(f, a1, a2, a3, a4) \ do \ { \ DEBUG_4(f, a1, a2, a3, a4); \ if (!f(a1, a2, a3, a4)) \ return FALSE; \ } \ while (0) #define PRIM_CSTR_5(f, a1, a2, a3, a4, a5) \ do \ { \ DEBUG_5(f, a1, a2, a3, a4, a5); \ if (!f(a1, a2, a3, a4, a5)) \ return FALSE; \ } \ while (0) #define PRIM_CSTR_6(f, a1, a2, a3, a4, a5, a6) \ do \ { \ DEBUG_6(f, a1, a2, a3, a4, a5, a6); \ if (!f(a1, a2, a3, a4, a5, a6)) \ return FALSE; \ } \ while (0) #define MATH_CSTR_2(f, a1, a2) \ do \ { \ if (pl_full_ac == FALSE) \ PRIM_CSTR_2(f, a1, a2); \ else \ PRIM_CSTR_2(f##_F, a1, a2); \ } \ while (0) #define MATH_CSTR_3(f, a1, a2, a3) \ do \ { \ if (pl_full_ac == FALSE) \ PRIM_CSTR_3(f, a1, a2, a3); \ else \ PRIM_CSTR_3(f##_F, a1, a2, a3); \ } \ while (0) #define MATH_CSTR_4(f, a1, a2, a3, a4) \ do \ { \ if (pl_full_ac == FALSE) \ PRIM_CSTR_4(f, a1, a2, a3, a4); \ else \ PRIM_CSTR_4(f##_F, a1, a2, a3, a4); \ } \ while (0) #define MATH_CSTR_5(f, a1, a2, a3, a4, a5) \ do \ { \ if (pl_full_ac == FALSE) \ PRIM_CSTR_5(f, a1, a2, a3, a4, a5); \ else \ PRIM_CSTR_5(f##_F, a1, a2, a3, a4, a5); \ } \ while (0) #define MATH_CSTR_6(f, a1, a2, a3, a4, a5, a6) \ do \ { \ if (pl_full_ac == FALSE) \ PRIM_CSTR_6(f, a1, a2, a3, a4, a5, a6); \ else \ PRIM_CSTR_6(f##_F, a1, a2, a3, a4, a5, a6); \ } \ while (0) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_infos_c.c���������������������������������������������������������������0000644�0001750�0001750�00000021657�13021324543�015465� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_infos_c.c * * Descr.: FD variable information management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "engine_fd.h" #include "bips_pl.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_FD_VECTOR_MAX_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Vector_Max_1(WamWord max_word) { return Pl_Un_Integer_Check(pl_vec_max_integer, max_word); } /*-------------------------------------------------------------------------* * PL_FD_SET_VECTOR_MAX_1 * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Set_Vector_Max_1(WamWord max_word) { Pl_Define_Vector_Size(Pl_Rd_Positive_Check(max_word)); } /*-------------------------------------------------------------------------* * PL_FD_MAX_INTEGER_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Max_Integer_1(WamWord inf_word) { return Pl_Un_Integer_Check(INTERVAL_MAX_INTEGER, inf_word); } /*-------------------------------------------------------------------------* * PL_FD_MIN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Min_2(WamWord fdv_word, WamWord min_word) { WamWord word, tag_mask; int n; Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) n = UnTag_INT(word); else n = Min(UnTag_FDV(word)); return Pl_Un_Integer_Check(n, min_word); } /*-------------------------------------------------------------------------* * PL_FD_MAX_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Max_2(WamWord fdv_word, WamWord max_word) { WamWord word, tag_mask; int n; Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) n = UnTag_INT(word); else n = Max(UnTag_FDV(word)); return Pl_Un_Integer_Check(n, max_word); } /*-------------------------------------------------------------------------* * PL_FD_DOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Dom_2(WamWord fdv_word, WamWord list_word) { WamWord word, tag_mask; WamWord *fdv_adr; int x, end; int vec_elem; Pl_Check_For_Un_List(list_word); Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { x = UnTag_INT(word); if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(x)) return FALSE; list_word = Pl_Unify_Variable(); } else { fdv_adr = UnTag_FDV(word); if (Is_Interval(Range(fdv_adr))) { end = Max(fdv_adr); for (x = Min(fdv_adr); x <= end; x++) { if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(x)) return FALSE; list_word = Pl_Unify_Variable(); } } else { VECTOR_BEGIN_ENUM(Vec(fdv_adr), vec_elem); if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(vec_elem)) return FALSE; list_word = Pl_Unify_Variable(); VECTOR_END_ENUM; } } return Pl_Get_Nil(list_word); } /*-------------------------------------------------------------------------* * PL_FD_SIZE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Size_2(WamWord fdv_word, WamWord size_word) { WamWord word, tag_mask; int n; Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) n = 1; else n = Nb_Elem(UnTag_FDV(word)); return Pl_Un_Integer_Check(n, size_word); } /*-------------------------------------------------------------------------* * PL_FD_HAS_EXTRA_CSTR_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Has_Extra_Cstr_1(WamWord fdv_word) { WamWord word, tag_mask; Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); return tag_mask == TAG_FDV_MASK && Extra_Cstr(UnTag_FDV(word)); } /*-------------------------------------------------------------------------* * PL_FD_HAS_VECTOR_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Has_Vector_1(WamWord fdv_word) { WamWord word, tag_mask; Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); return tag_mask == TAG_FDV_MASK && Is_Sparse(Range(UnTag_FDV(word))); } /*-------------------------------------------------------------------------* * PL_FD_USE_VECTOR_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Use_Vector_1(WamWord fdv_word) { WamWord word, tag_mask; Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask); return tag_mask == TAG_INT_MASK || Pl_Fd_Use_Vector(UnTag_FDV(word)); } ���������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_values_fd.fd������������������������������������������������������������0000644�0001750�0001750�00000005700�13021324543�016153� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_values_fd.fd * * Descr.: FD variable values management - FD part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ pl_fd_domain(fdv X, int L, int U) { start X in L .. U } pl_fd_not_domain(fdv X, int L, int U) { start X in ~(L .. U) } pl_fd_domain_r(fdv X, range R) { start X in R } pl_fd_not_domain_r(fdv X, range R) { start X in ~R } ����������������������������������������������������������������gprolog-1.4.5/src/BipsFD/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000140�13021324543�015200� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile BETWEEN.c SPLIT.pl KNIGHT.pl t_fd.c PRIMITIVES NTH_ROOT.c GENER_PRIM.c EX.pl CREW3.pl ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/t_fd.fd��������������������������������������������������������������������0000644�0001750�0001750�00000004042�13021324543�014444� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : development only * * File : t_fd.fd * * Descr.: test - FD part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * GNU Prolog is free software; you can redistribute it and/or modify it * * under the terms of the GNU General Public License as published by the * * Free Software Foundation; either version 2, or any later version. * * * * GNU Prolog 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. * * 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. * *-------------------------------------------------------------------------*/ /* * You can put your own test code in these files (see DEVELOPMENT) * t.pl (Prolog part) * t_c.c (C part, eg. foreign code or C code used by your FD constraints) * t_fd.fd (FD constraint part) */ /* %{ Bool Pl_Fd_All_Distinct(WamWord *array); %} foo(fdv I) { start I in 2..4:1..1 } */ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_symbolic_c.c������������������������������������������������������������0000644�0001750�0001750�00000031173�13021324543�016162� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_symbolic_c.c * * Descr.: symbolic constraints management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Fd_All_Different_Rec(WamWord list_word, PlLong x_tag, WamWord x_word, WamWord save_list_word); /*-------------------------------------------------------------------------* * PL_FD_ALL_DIFFERENT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_All_Different_1(WamWord list_word, WamWord save_list_word) { WamWord word, tag_mask; WamWord *lst_adr; DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) return TRUE; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK && tag_mask != TAG_FDV_MASK) Pl_Err_Type(pl_type_fd_variable, word); return Fd_All_Different_Rec(Cdr(lst_adr), tag_mask, word, save_list_word) && Pl_Fd_All_Different_1(Cdr(lst_adr), save_list_word); } /*-------------------------------------------------------------------------* * FD_ALL_DIFFERENT_REC * * * *-------------------------------------------------------------------------*/ static Bool Fd_All_Different_Rec(WamWord list_word, PlLong x_tag, WamWord x_word, WamWord save_list_word) { WamWord word, tag_mask; WamWord *lst_adr; int ret; DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) return TRUE; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK && tag_mask != TAG_FDV_MASK) Pl_Err_Type(pl_type_fd_variable, word); if (x_tag == TAG_INT_MASK) ret = (tag_mask == TAG_INT_MASK) ? x_word != word : pl_x_neq_c(word, x_word); else ret = (tag_mask == TAG_INT_MASK) ? pl_x_neq_c(x_word, word) : pl_x_neq_y(x_word, word); return ret && Fd_All_Different_Rec(Cdr(lst_adr), x_tag, x_word, save_list_word); } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_I * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Element_I(Range *i, WamWord *l) { int n = *l; /* I in 1..N in sparse mode */ Range_Init_Interval(i, 1, n); Pl_Range_Becomes_Sparse(i); } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_I_TO_V * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Element_I_To_V(Range *v, Range *i, WamWord *l) { int val; int j; /* when I changes -> update V */ Vector_Allocate(v->vec); Pl_Vector_Empty(v->vec); if (i->min == i->max || Is_Interval(i)) { for (j = i->min; j <= i->max; j++) { val = l[j]; Vector_Set_Value(v->vec, val); } } else { VECTOR_BEGIN_ENUM(i->vec, j); val = l[j]; Vector_Set_Value(v->vec, val); VECTOR_END_ENUM; } Pl_Range_From_Vector(v); } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_V_TO_I * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Element_V_To_I(Range *i, Range *v, WamWord *l) { int val; int n; int j; /* when V changes -> update I */ Vector_Allocate(i->vec); Pl_Vector_Empty(i->vec); n = *l; for (j = 1; j <= n; j++) { val = l[j]; /* val=Lj */ if (Pl_Range_Test_Value(v, val)) Vector_Set_Value(i->vec, j); } Pl_Range_From_Vector(i); } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_VAR_I * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Element_Var_I(Range *i, WamWord *l) { int n = *l; /* I in 1..N in sparse mode */ Range_Init_Interval(i, 1, n); Pl_Range_Becomes_Sparse(i); } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_VAR_I_TO_V * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Element_Var_I_To_V(Range *v, Range *i, WamWord **l) { WamWord *fdv_adr; int j; v->extra_cstr = FALSE; v->vec = 0; Set_To_Empty(v); /* when I or L changes -> update V */ if (i->min == i->max || Is_Interval(i)) { for (j = i->min; j <= i->max; j++) { fdv_adr = l[j]; Pl_Range_Union(v, Range(fdv_adr)); } } else { VECTOR_BEGIN_ENUM(i->vec, j); fdv_adr = l[j]; Pl_Range_Union(v, Range(fdv_adr)); VECTOR_END_ENUM; } } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_VAR_V_TO_I * * * *-------------------------------------------------------------------------*/ void Pl_Fd_Element_Var_V_To_I(Range *i, Range *v, WamWord **l) { WamWord *fdv_adr; PlLong n; int j; Vector_Allocate(i->vec); Pl_Vector_Empty(i->vec); /* when V or L changes -> update I */ n = (PlLong) *l; for (j = 1; j <= n; j++) { fdv_adr = l[j]; if (!Pl_Range_Test_Null_Inter(Range(fdv_adr), v)) Vector_Set_Value(i->vec, j); } Pl_Range_From_Vector(i); } /*-------------------------------------------------------------------------* * PL_FD_ELEMENT_V_TO_XI * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Element_V_To_Xi(int i, WamWord **array, Range *v) { WamWord *fdv_adr = array[i]; if (Fd_Variable_Is_Ground(fdv_adr)) return Pl_Fd_Tell_Int_Range(fdv_adr, v); return Pl_Fd_Tell_Range_Range(fdv_adr, v); } /*-------------------------------------------------------------------------* * PL_FD_ATMOST * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Atmost(int n, WamWord **array, int v) { WamWord **p; WamWord word = Tag_INT(v); PlLong size = (PlLong) array[0]; int nb = 0; int i; array++; p = array; for (i = 0; i < size; i++) { if (FD_Tag_Value(*p) == word) nb++; p++; } if (nb > n) return FALSE; if (nb == n) { p = array; for (i = 0; i < size; i++) { if (!Fd_Variable_Is_Ground(*p)) if (!Pl_Fd_Tell_Not_Value(*p, v)) return FALSE; p++; } } return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_ATLEAST * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Atleast(int n, WamWord **array, int v) { WamWord **p; PlLong size = (PlLong) array[0]; int nb = size; int i; array++; p = array; for (i = 0; i < size; i++) { if (!Pl_Range_Test_Value(Range(*p), v)) nb--; p++; } if (nb < n) return FALSE; if (nb == n) { p = array; for (i = 0; i < size; i++) { if (Pl_Range_Test_Value(Range(*p), v)) if (!Pl_Fd_Tell_Value(*p, v)) return FALSE; p++; } } return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_EXACTLY * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Exactly(int n, WamWord **array, int v) { WamWord **p; WamWord word = Tag_INT(v); PlLong size = (PlLong) array[0]; int nb1 = 0, nb2 = size; int i; array++; p = array; for (i = 0; i < size; i++) { if (FD_Tag_Value(*p) == word) nb1++; else if (!Pl_Range_Test_Value(Range(*p), v)) nb2--; p++; } if (nb1 > n || nb2 < n) return FALSE; if (nb1 == n) { p = array; for (i = 0; i < size; i++) { if (!Fd_Variable_Is_Ground(*p)) if (!Pl_Fd_Tell_Not_Value(*p, v)) return FALSE; p++; } return TRUE; } if (nb2 == n) { p = array; for (i = 0; i < size; i++) { if (Pl_Range_Test_Value(Range(*p), v)) if (!Pl_Fd_Tell_Value(*p, v)) return FALSE; p++; } } return TRUE; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/oper_supp.c����������������������������������������������������������������0000644�0001750�0001750�00000041445�13021324543�015405� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : oper_supp.c * * Descr.: FD Operation support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static unsigned Find_Expon_General(unsigned x, unsigned y, unsigned *pxn); /*-------------------------------------------------------------------------* * PL_POWER * * * *-------------------------------------------------------------------------*/ unsigned Pl_Power(unsigned x, unsigned n) { unsigned xn, xp; if (n == 0 || x == 1) return 1; if (x == 0) return 0; if (n >= sizeof(unsigned) * 8) return INTERVAL_MAX_INTEGER; xn = 1; xp = x; while (n) { if (n & 1) xn *= xp; xp *= xp; n >>= 1; } return ((PlLong) xn > 0 && (PlLong) xn <= INTERVAL_MAX_INTEGER) ? xn : INTERVAL_MAX_INTEGER; } /*-------------------------------------------------------------------------* * PL_NTH_ROOT_DN * * * *-------------------------------------------------------------------------*/ unsigned Pl_Nth_Root_Dn(unsigned y, unsigned n) { unsigned old, new; unsigned n1 = n - 1; unsigned oldn1; int bit, nb; if (y == 0) return 0; if (n == 0) return INTERVAL_MAX_INTEGER; if (n >= sizeof(unsigned) * 8) return 1; bit = Pl_Most_Significant_Bit(y); if ((unsigned) (bit + 1) < n) return 1; nb = bit / n; new = 1 << nb; old = new; oldn1 = Pl_Power(old, n1); new = (n1 * old + y / oldn1) / n; do { old = new; oldn1 = Pl_Power(old, n1); new = (n1 * old + y / oldn1) / n; } while (new < old); return old; } /*-------------------------------------------------------------------------* * PL_NTH_ROOT_UP * * * *-------------------------------------------------------------------------*/ unsigned Pl_Nth_Root_Up(unsigned y, unsigned n) { unsigned x; if (y == 0) return 0; if (n == 0) return 0; x = Pl_Nth_Root_Dn(y, n); if (Pl_Power(x, n) != y) x++; return x; } /*-------------------------------------------------------------------------* * PL_NTH_ROOT_EXACT * * * *-------------------------------------------------------------------------*/ unsigned Pl_Nth_Root_Exact(unsigned y, unsigned n) { unsigned x; if (y == 0) return 0; x = Pl_Nth_Root_Dn(y, n); if (Pl_Power(x, n) != y) return (unsigned) -1; return x; } /*-------------------------------------------------------------------------* * PL_SQRT_DN * * * *-------------------------------------------------------------------------*/ unsigned Pl_Sqrt_Dn(unsigned y) { unsigned old, new; if (y == 0) return 0; new = y; do { old = new; new = (old + y / old) >> 1; } while (new < old); return old; } /*-------------------------------------------------------------------------* * PL_SQRT_UP * * * *-------------------------------------------------------------------------*/ unsigned Pl_Sqrt_Up(unsigned y) { unsigned x; x = Pl_Sqrt_Dn(y); if (x * x != y) x++; return x; } /*-------------------------------------------------------------------------* * PL_SQRT_EXACT * * * *-------------------------------------------------------------------------*/ unsigned Pl_Sqrt_Exact(unsigned y) { unsigned x; x = Pl_Sqrt_Dn(y); if (x * x != y) return (unsigned) -1; return x; } /*-------------------------------------------------------------------------* * PL_FIND_EXPON_DN * * * *-------------------------------------------------------------------------*/ unsigned Pl_Find_Expon_Dn(unsigned x, unsigned y) { unsigned n; unsigned xn; if (x <= 1 || y == 0) return INTERVAL_MAX_INTEGER; n = Find_Expon_General(x, y, &xn); return n; } /*-------------------------------------------------------------------------* * PL_FIND_EXPON_UP * * * * X must be > 1 and Y must be > 0 * *-------------------------------------------------------------------------*/ unsigned Pl_Find_Expon_Up(unsigned x, unsigned y) { unsigned n; unsigned xn; if (x <= 1 || y == 0) return INTERVAL_MAX_INTEGER; n = Find_Expon_General(x, y, &xn); return n + (y != xn); } /*-------------------------------------------------------------------------* * PL_FIND_EXPON_EXACT * * * * X must be > 1 and Y must be > 0 * *-------------------------------------------------------------------------*/ unsigned Pl_Find_Expon_Exact(unsigned x, unsigned y) { unsigned n; unsigned xn; if (x <= 1 || y == 0) return INTERVAL_MAX_INTEGER; n = Find_Expon_General(x, y, &xn); if (y != xn) return (unsigned) -1; return n; } /*-------------------------------------------------------------------------* * FIND_EXPON_GENERAL * * * * X must be >1 and Y must be >0 * *-------------------------------------------------------------------------*/ static unsigned Find_Expon_General(unsigned x, unsigned y, unsigned *pxn) { static unsigned txp[sizeof(unsigned) * 8]; unsigned *p = txp; unsigned xp; unsigned prod; unsigned n; unsigned xn; p = txp; xp = x; prod = 1; while (prod < y && (PlLong) xp > 0) { *p++ = xp; prod *= xp; xp *= xp; } n = 0; xn = 1; while (--p >= txp) { xp = *p; n <<= 1; if (y >= xp) { y /= xp; xn *= xp; n |= 1; } } *pxn = xn; return n; } /*-------------------------------------------------------------------------* * PL_FULL_COEFF_POWER_VAR * * * *-------------------------------------------------------------------------*/ void Pl_Full_Coeff_Power_Var(Range *y, int a, Range *n) { unsigned an, an0; int i, vec_elem; an = Pl_Power(a, n->min); Vector_Allocate(y->vec); if (an > (unsigned) pl_vec_max_integer) { y->extra_cstr = TRUE; Set_To_Empty(y); return; } Pl_Vector_Empty(y->vec); y->extra_cstr = FALSE; y->min = an; if (Is_Interval(n)) /* N is Interval */ { an0 = an; for (i = n->min; i <= n->max; i++) { if (an0 > (unsigned) pl_vec_max_integer) goto end_loop; an = an0; Vector_Set_Value(y->vec, an); an0 *= a; } } else /* N is Sparse */ { y->extra_cstr = n->extra_cstr; VECTOR_BEGIN_ENUM(n->vec, vec_elem); an = Pl_Power(a, vec_elem); if (an > (unsigned) pl_vec_max_integer) goto end_loop; Vector_Set_Value(y->vec, an); VECTOR_END_ENUM; } end_loop: y->max = an; } /*-------------------------------------------------------------------------* * PL_FULL_FIND_EXPON * * * * Here A>=2 then Y>=1 * *-------------------------------------------------------------------------*/ void Pl_Full_Find_Expon(Range *n, int a, Range *y) { int e, min; int i, vec_elem; Vector_Allocate(n->vec); Pl_Vector_Empty(n->vec); n->extra_cstr = y->extra_cstr; min = -1; if (Is_Interval(y)) /* Y is Interval */ { for (i = y->min; i <= y->max; i++) { e = Pl_Find_Expon_Exact(a, i); if (e >= 0) { if (min < 0) min = e; Vector_Set_Value(n->vec, e); } } } else /* Y is Sparse */ { VECTOR_BEGIN_ENUM(y->vec, vec_elem); e = Pl_Find_Expon_Exact(a, vec_elem); if (e >= 0) { if (min < 0) min = e; Vector_Set_Value(n->vec, e); } VECTOR_END_ENUM; } n->min = min; n->max = e; } /*-------------------------------------------------------------------------* * PL_FULL_VAR_POWER_COEFF * * * *-------------------------------------------------------------------------*/ void Pl_Full_Var_Power_Coeff(Range *y, Range *x, int a) { unsigned xa; int i, vec_elem; xa = Pl_Power(x->min, a); Vector_Allocate(y->vec); if (xa > (unsigned) pl_vec_max_integer) { y->extra_cstr = TRUE; Set_To_Empty(y); return; } Pl_Vector_Empty(y->vec); y->extra_cstr = FALSE; y->min = xa; if (Is_Interval(x)) /* X is Interval */ { for (i = x->min; i <= x->max; i++) { xa = Pl_Power(i, a); if (xa > (unsigned) pl_vec_max_integer) goto end_loop; Vector_Set_Value(y->vec, xa); } } else /* X is Sparse */ { y->extra_cstr = x->extra_cstr; VECTOR_BEGIN_ENUM(x->vec, vec_elem); xa = Pl_Power(vec_elem, a); if (xa > (unsigned) pl_vec_max_integer) goto end_loop; Vector_Set_Value(y->vec, xa); VECTOR_END_ENUM; } end_loop: y->max = xa; } /*-------------------------------------------------------------------------* * PL_FULL_NTH_ROOT * * * *-------------------------------------------------------------------------*/ void Pl_Full_Nth_Root(Range *x, Range *y, int a) { int e, min; int i, vec_elem; Vector_Allocate(x->vec); Pl_Vector_Empty(x->vec); x->extra_cstr = y->extra_cstr; min = -1; if (Is_Interval(y)) /* Y is Interval */ { for (i = y->min; i <= y->max; i++) { e = Pl_Nth_Root_Exact(i, a); if (e >= 0) { if (min < 0) min = e; Vector_Set_Value(x->vec, e); } } } else /* Y is Sparse */ { VECTOR_BEGIN_ENUM(y->vec, vec_elem); e = Pl_Nth_Root_Exact(vec_elem, a); if (e >= 0) { if (min < 0) min = e; Vector_Set_Value(x->vec, e); } VECTOR_END_ENUM; } x->min = min; x->max = e; } /*-------------------------------------------------------------------------* * PL_FULL_VAR_POWER_2 * * * *-------------------------------------------------------------------------*/ void Pl_Full_Var_Power_2(Range *y, Range *x) { unsigned x2; int i, vec_elem; x2 = x->min * x->min; Vector_Allocate(y->vec); if (x2 > (unsigned) pl_vec_max_integer) { y->extra_cstr = TRUE; Set_To_Empty(y); return; } Pl_Vector_Empty(y->vec); y->extra_cstr = FALSE; y->min = x2; if (Is_Interval(x)) /* X is Interval */ { for (i = x->min; i <= x->max; i++) { x2 = i * i; if (x2 > (unsigned) pl_vec_max_integer) goto end_loop; Vector_Set_Value(y->vec, x2); } } else /* X is Sparse */ { y->extra_cstr = x->extra_cstr; VECTOR_BEGIN_ENUM(x->vec, vec_elem); x2 = vec_elem * vec_elem; if (x2 > (unsigned) pl_vec_max_integer) goto end_loop; Vector_Set_Value(y->vec, x2); VECTOR_END_ENUM; } end_loop: y->max = x2; } /*-------------------------------------------------------------------------* * PL_FULL_SQRT_VAR * * * *-------------------------------------------------------------------------*/ void Pl_Full_Sqrt_Var(Range *x, Range *y) { int e, min; int i, vec_elem; Vector_Allocate(x->vec); Pl_Vector_Empty(x->vec); x->extra_cstr = y->extra_cstr; min = -1; if (Is_Interval(y)) /* Y is Interval */ { for (i = y->min; i <= y->max; i++) { e = Pl_Sqrt_Exact(i); if (e >= 0) { if (min < 0) min = e; Vector_Set_Value(x->vec, e); } } } else /* Y is Sparse */ { VECTOR_BEGIN_ENUM(y->vec, vec_elem); e = Pl_Sqrt_Exact(vec_elem); if (e >= 0) { if (min < 0) min = e; Vector_Set_Value(x->vec, e); } VECTOR_END_ENUM; } x->min = min; x->max = e; } /*-------------------------------------------------------------------------* * PL_FULL_VAR_DIV_VAR * * * *-------------------------------------------------------------------------*/ void Pl_Full_Var_Div_Var(Range *x, Range *z, Range *y) { if (y->min == 0) { Range_Init_Interval(x, 0, INTERVAL_MAX_INTEGER); return; } Pl_Range_Copy(x, z); Pl_Range_Div_Range(x, y); } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/math_supp.c����������������������������������������������������������������0000644�0001750�0001750�00000115211�13021324543�015362� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : math_supp.c * * Descr.: mathematical support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <stdarg.h> #include <string.h> #define OBJ_INIT Math_Supp_Initializer #define MATH_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" #if 1 #define DEVELOP_TIMES_2 #endif /*---------------------------------* * Constants * *---------------------------------*/ #define DELAY_CSTR_STACK_SIZE 1000 #define VARS_STACK_SIZE 100000 #define MAX_MONOMS 2000 #define MAX_COEF_FOR_SORT 100 #define PLUS_1 0 #define PLUS_2 1 #define MINUS_1 2 #define MINUS_2 3 #define TIMES_2 4 #define DIV_2 5 #define POWER_2 6 #define MIN_2 7 #define MAX_2 8 #define DIST_2 9 #define QUOT_2 10 #define REM_2 11 #define QUOT_REM_3 12 #define NB_OF_OP 13 #define DC_X2_EQ_Y 0 #define DC_XY_EQ_Z 1 #define DC_DIV_A_Y_EQ_Z 2 #define DC_DIV_X_A_EQ_Z 3 #define DC_DIV_X_Y_EQ_Z 4 #define DC_ZERO_POWER_N_EQ_Y 5 #define DC_A_POWER_N_EQ_Y 6 #define DC_X_POWER_A_EQ_Y 7 #define DC_MIN_X_A_EQ_Z 8 #define DC_MIN_X_Y_EQ_Z 9 #define DC_MAX_X_A_EQ_Z 10 #define DC_MAX_X_Y_EQ_Z 11 #define DC_ABS_X_MINUS_A_EQ_Z 12 #define DC_ABS_X_MINUS_Y_EQ_Z 13 #define DC_QUOT_REM_A_Y_R_EQ_Z 14 #define DC_QUOT_REM_X_A_R_EQ_Z 15 #define DC_QUOT_REM_X_Y_R_EQ_Z 16 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct /* Monomial term information */ { /* ------------------------------ */ PlLong a; /* coefficient */ WamWord x_word; /* variable a tagged <REF,adr> */ } Monom; typedef struct /* Polynomial term information */ { /* ------------------------------ */ PlLong c; /* the constant */ int nb_monom; /* nb of monomial terms */ Monom m[MAX_MONOMS]; /* table of monomial terms */ } Poly; typedef struct /* Non linear constr information */ { /* ------------------------------ */ int cstr; /* DC_X2_EQ_Y, DC_XY_EQ_Z,... */ WamWord a1, a2, a3; /* arguments (input) */ WamWord res; /* argument (result) */ } NonLin; /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord arith_tbl[NB_OF_OP]; static NonLin delay_cstr_stack[DELAY_CSTR_STACK_SIZE]; static NonLin *delay_sp; static WamWord vars_tbl[VARS_STACK_SIZE]; static WamWord *vars_sp; static Bool sort; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Load_Left_Right_Rec(Bool optim_eq, WamWord le_word, WamWord re_word, int *mask, WamWord *c_word, WamWord *l_word, WamWord *r_word); static int Compar_Monom(Monom *m1, Monom *m2); static Bool Load_Term_Into_Word(WamWord e_word, WamWord *load_word); static WamWord Push_Delayed_Cstr(int cstr, WamWord a1, WamWord a2, WamWord a3); static void Add_Monom(Poly *p, int sign, PlLong a, WamWord x_word); #ifdef DEVELOP_TIMES_2 static Bool Add_Multiply_Monom(Poly *p, int sign, Monom *m1, Monom *m2); #endif static Bool Normalize(WamWord e_word, int sign, Poly *p); static Bool Load_Poly(int nb_monom, Monom *m, WamWord pref_load_word, WamWord *load_word); static Bool Load_Poly_Rec(int nb_monom, Monom *m, WamWord load_word); static Bool Load_Delay_Cstr_Part(void); #ifdef DEBUG void Pl_Write_1(WamWord term_word); #endif #define New_Tagged_Fd_Variable (Tag_REF(Pl_Fd_New_Variable())) #define New_Poly(p) ((p).c = (p).nb_monom = 0) #define Add_Cst_To_Poly(p, s, w) (p->c += s * w) /*-------------------------------------------------------------------------* * MATH_SUPP_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Math_Supp_Initializer(void) { arith_tbl[PLUS_1] = Functor_Arity(ATOM_CHAR('+'), 1); arith_tbl[PLUS_2] = Functor_Arity(ATOM_CHAR('+'), 2); arith_tbl[MINUS_1] = Functor_Arity(ATOM_CHAR('-'), 1); arith_tbl[MINUS_2] = Functor_Arity(ATOM_CHAR('-'), 2); arith_tbl[TIMES_2] = Functor_Arity(ATOM_CHAR('*'), 2); arith_tbl[POWER_2] = Functor_Arity(Pl_Create_Atom("**"), 2); arith_tbl[DIV_2] = Functor_Arity(ATOM_CHAR('/'), 2); arith_tbl[MIN_2] = Functor_Arity(Pl_Create_Atom("min"), 2); arith_tbl[MAX_2] = Functor_Arity(Pl_Create_Atom("max"), 2); arith_tbl[DIST_2] = Functor_Arity(Pl_Create_Atom("dist"), 2); arith_tbl[QUOT_2] = Functor_Arity(Pl_Create_Atom("//"), 2); arith_tbl[REM_2] = Functor_Arity(Pl_Create_Atom("rem"), 2); arith_tbl[QUOT_REM_3] = Functor_Arity(Pl_Create_Atom("quot_rem"), 3); } /*-------------------------------------------------------------------------* * PL_LOAD_LEFT_RIGHT * * * * This function loads the left and right term of a constraint into (new) * * variables. * * Input: * * optim_eq: is used to optimize loadings of a term1 #= term2 constraint* * when the constant is zero. * * le_word : left term of the constraint * * re_word : right term of the constraint * * * * Output: * * mask : indicates if l_word and r_word are used (see MASK_... cst) * * c : the general (signed) constant * * l_word : the variable containing the left part (tagged <REF,adr>) * * r_word : the variable containing the right part (tagged <REF,adr>) * *-------------------------------------------------------------------------*/ Bool Pl_Load_Left_Right(Bool optim_eq, WamWord le_word, WamWord re_word, int *mask, PlLong *c, WamWord *l_word, WamWord *r_word) { #ifdef DEBUG DBGPRINTF("\n*** Math constraint : "); Pl_Write_1(le_word); DBGPRINTF(" %s ", cur_op); Pl_Write_1(re_word); DBGPRINTF("\n"); #endif delay_sp = delay_cstr_stack; vars_sp = vars_tbl; return Load_Left_Right_Rec(optim_eq, le_word, re_word, mask, c, l_word, r_word); } /*-------------------------------------------------------------------------* * PL_TERM_MATH_LOADING * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Math_Loading(WamWord l_word, WamWord r_word) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; if (delay_sp != delay_cstr_stack) { #ifdef DEBUG DBGPRINTF("\nnon Linear part\n"); #endif if (!Load_Delay_Cstr_Part()) return FALSE; } while (--vars_sp >= vars_tbl) { DEREF(*vars_sp, word, tag_mask); if (tag_mask == TAG_REF_MASK && word != l_word && word != r_word) { adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); } } return TRUE; } /*-------------------------------------------------------------------------* * LOAD_LEFT_RIGHT_REC * * * * This function can be called with re_word == NOT_A_WAM_WORD by the fct * * Load_Term_Into_Word(). In that case, re_word is simply ignored. * *-------------------------------------------------------------------------*/ static Bool Load_Left_Right_Rec(Bool optim_eq, WamWord le_word, WamWord re_word, int *mask, PlLong *c, WamWord *l_word, WamWord *r_word) { Poly p; Monom *l_m, *r_m; Monom *cur, *pos, *neg, *end; int l_nb_monom, r_nb_monom; WamWord pref_load_word; /* to optimize equalities (#=) */ int i; sort = FALSE; New_Poly(p); if (!Normalize(le_word, +1, &p)) return FALSE; if (re_word != NOT_A_WAM_WORD && !Normalize(re_word, -1, &p)) return FALSE; if (sort || p.nb_monom > MAX_MONOMS / 2) { qsort(p.m, p.nb_monom, sizeof(Monom), (int (*)(const void *, const void *)) Compar_Monom); for (i = 0; i < p.nb_monom; i++) /* find left monomial terms */ if (p.m[i].a <= 0) break; l_m = p.m; l_nb_monom = i; for (; i < p.nb_monom; i++) /* find right monomial terms */ if (p.m[i].a >= 0) break; else p.m[i].a = -p.m[i].a; /* only positive coefs now */ r_m = l_m + l_nb_monom; r_nb_monom = i - l_nb_monom; } else { pos = p.m; end = pos + p.nb_monom; neg = end; for (cur = pos; cur < end; cur++) { if (cur->a < 0) { neg->a = -cur->a; neg->x_word = cur->x_word; neg++; continue; } if (cur->a > 0) { if (cur != pos) *pos = *cur; pos++; } } l_m = p.m; l_nb_monom = pos - l_m; r_m = end; r_nb_monom = neg - r_m; #ifdef DEBUG DBGPRINTF("l_nb_monom:%d r_nb_monom:%d\n", l_nb_monom, r_nb_monom); #endif } #ifdef DEBUG DBGPRINTF("normalization: "); for (i = 0; i < l_nb_monom; i++) { DBGPRINTF("%" PL_FMT_d "*", l_m[i].a); Pl_Write_1(l_m[i].x_word); DBGPRINTF(" + "); } if (p.c > 0) DBGPRINTF("%" PL_FMT_d " + ", p.c); else if (l_nb_monom == 0) DBGPRINTF("0 + "); DBGPRINTF("\b\b%s ", (re_word != NOT_A_WAM_WORD) ? cur_op : "="); for (i = 0; i < r_nb_monom; i++) { DBGPRINTF("%" PL_FMT_d "*", r_m[i].a); Pl_Write_1(r_m[i].x_word); DBGPRINTF(" + "); } if (p.c < 0) DBGPRINTF("%" PL_FMT_d " + ", -p.c); else if (r_nb_monom == 0 && re_word != NOT_A_WAM_WORD) DBGPRINTF("0 + "); if (re_word == NOT_A_WAM_WORD) DBGPRINTF("loaded + "); DBGPRINTF("\b\b \n\n"); #endif pref_load_word = NOT_A_WAM_WORD; *mask = MASK_EMPTY; if (l_nb_monom) { *mask |= MASK_LEFT; if (optim_eq && p.c == 0 && r_nb_monom == 1 && r_m[0].a == 1) pref_load_word = r_m[0].x_word; if (!Load_Poly(l_nb_monom, l_m, pref_load_word, l_word)) return FALSE; } if (r_nb_monom) { *mask |= MASK_RIGHT; if (pref_load_word == NOT_A_WAM_WORD) { if (optim_eq && p.c == 0 && l_nb_monom) pref_load_word = *l_word; if (!Load_Poly(r_nb_monom, r_m, pref_load_word, r_word)) return FALSE; } } *c = p.c; return TRUE; } /*-------------------------------------------------------------------------* * LOAD_TERM_INTO_WORD * * * * This function loads a term into a (tagged) word. * * Input: * * e_word : term to load * * * * Output: * * load_word: the tagged word containing the loading of the term: * * can be a <INT,val> if there is no variable or a <REF,adr>) * * * * This functions acts like T #= NewVar. However, if T is just an integer * * it avoids the creation of a useless FD NewVar. * *-------------------------------------------------------------------------*/ static Bool Load_Term_Into_Word(WamWord e_word, WamWord *load_word) { int mask; WamWord l_word, r_word, word; PlLong c; if (!Load_Left_Right_Rec(FALSE, e_word, NOT_A_WAM_WORD, &mask, &c, &l_word, &r_word)) return FALSE; if (mask == MASK_EMPTY) { if (c < 0) return FALSE; *load_word = Tag_INT(c); return TRUE; } if (mask == MASK_LEFT && c == 0) { *load_word = l_word; return TRUE; } *load_word = New_Tagged_Fd_Variable; switch (mask) { case MASK_LEFT: /* here c != 0 */ if (c > 0) MATH_CSTR_3(pl_x_plus_c_eq_y, l_word, Tag_INT(c), *load_word); else MATH_CSTR_3(pl_x_plus_c_eq_y, *load_word, Tag_INT(-c), l_word); return TRUE; case MASK_RIGHT: if (c < 0) return FALSE; word = New_Tagged_Fd_Variable; MATH_CSTR_3(pl_x_plus_y_eq_z, r_word, *load_word, word); PRIM_CSTR_2(pl_x_eq_c, word, Tag_INT(c)); return TRUE; } if (c == 0) { MATH_CSTR_3(pl_x_plus_y_eq_z, r_word, *load_word, l_word); return TRUE; } word = New_Tagged_Fd_Variable; MATH_CSTR_3(pl_x_plus_y_eq_z, r_word, *load_word, word); if (c > 0) MATH_CSTR_3(pl_x_plus_c_eq_y, l_word, Tag_INT(c), word); else MATH_CSTR_3(pl_x_plus_c_eq_y, word, Tag_INT(-c), l_word); return TRUE; } /*-------------------------------------------------------------------------* * COMPAR_MONOM * * * * This function is called by qsort to order a polynomial term. It compares* * 2 monomial terms according to the following sequence: * * * * positive coefficients (from greatest to smallest) * * negative coefficients (from smallest to greatest) * * (ie. from |greatest| to |smallest|) * * null coefficients * *-------------------------------------------------------------------------*/ static int Compar_Monom(Monom *m1, Monom *m2) { PlLong cmp; if (m1->a > 0) cmp = (m2->a > 0) ? m2->a - m1->a : -1; else cmp = (m2->a > 0) ? +1 : m1->a - m2->a; return (cmp > 0) ? 1 : (cmp == 0) ? 0 : -1; } /*-------------------------------------------------------------------------* * PUSH_DELAYED_CSTR * * * *-------------------------------------------------------------------------*/ static WamWord Push_Delayed_Cstr(int cstr, WamWord a1, WamWord a2, WamWord a3) { WamWord res_word; res_word = Make_Self_Ref(H); Global_Push(res_word); if (delay_sp - delay_cstr_stack >= DELAY_CSTR_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); delay_sp->cstr = cstr; delay_sp->a1 = a1; delay_sp->a2 = a2; delay_sp->a3 = a3; delay_sp->res = res_word; delay_sp++; return res_word; } /*-------------------------------------------------------------------------* * ADD_MONOM * * * *-------------------------------------------------------------------------*/ static void Add_Monom(Poly *p, int sign, PlLong a, WamWord x_word) { int i; if (a == 0) return; if (sign < 0) a = -a; for (i = 0; i < p->nb_monom; i++) if (p->m[i].x_word == x_word) { p->m[i].a += a; return; } if (p->nb_monom >= MAX_MONOMS) Pl_Err_Resource(pl_resource_too_big_fd_constraint); p->m[p->nb_monom].a = a; p->m[p->nb_monom].x_word = x_word; p->nb_monom++; } #ifdef DEVELOP_TIMES_2 /*-------------------------------------------------------------------------* * ADD_MULTIPLY_MONOM * * * *-------------------------------------------------------------------------*/ static Bool Add_Multiply_Monom(Poly *p, int sign, Monom *m1, Monom *m2) { PlLong a; WamWord x_word; a = m1->a * m2->a; if (a == 0) return TRUE; x_word = (m1->x_word == m2->x_word) ? Push_Delayed_Cstr(DC_X2_EQ_Y, m1->x_word, 0, 0) : Push_Delayed_Cstr(DC_XY_EQ_Z, m1->x_word, m2->x_word, 0); Add_Monom(p, sign, a, x_word); return TRUE; } #endif /*-------------------------------------------------------------------------* * NORMALIZE * * * * This functions normalizes a term. * * Input: * * e_word: term to normalize * * sign : current sign of the term (-1 or +1) * * * * Output: * * p : the associated polynomial term * * * * Normalizes the term and loads it into p. * * Non-Linear operations are simplified and loaded into a stack to be * * executed later. * * * * T1*T2 : T1 and T2 are normalized to give the polynomials p1 and p2, with* * p1 = c1 + a1X1 + a2X2 + ... + anXn * * p2 = c2 + b1X1 + b2X2 + ... + bmXm * * and replaced by c1*c2 + * * a1X1 * c2 + a1X1 * b1X1 + ... + a1X1 * bmXm * * ... * * anX1 * c2 + anXn * b1X1 + ... + anXn * bmXm * * * * T1**T2: T1 and T2 are loaded into 2 new words word1 and word2 that can * * be integers or variables (tagged words). The code emitted * * depends on 3 possibilities (var**var is not allowed) * * (+ optim 1**T2, 0**T2, T1**0, T1**1), NB 0**0=1 * *-------------------------------------------------------------------------*/ static Bool Normalize(WamWord e_word, int sign, Poly *p) { WamWord word, tag_mask; WamWord *adr; WamWord *fdv_adr; WamWord word1, word2, word3; WamWord f_n, le_word, re_word; int i; PlLong n1, n2, n3; terminal_rec: DEREF(e_word, word, tag_mask); if (tag_mask == TAG_FDV_MASK) { fdv_adr = UnTag_FDV(word); Add_Monom(p, sign, 1, Tag_REF(fdv_adr)); return TRUE; } if (tag_mask == TAG_INT_MASK) { n1 = UnTag_INT(word); if (n1 > MAX_COEF_FOR_SORT) sort = TRUE; Add_Cst_To_Poly(p, sign, n1); return TRUE; } if (tag_mask == TAG_REF_MASK) { if (vars_sp - vars_tbl >= VARS_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); *vars_sp++ = word; Add_Monom(p, sign, 1, word); return TRUE; } if (tag_mask == TAG_ATM_MASK) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(e_word); Pl_Unify_Integer(0); type_error: Pl_Err_Type(pl_type_fd_evaluable, word); } if (tag_mask != TAG_STC_MASK) goto type_error; adr = UnTag_STC(word); f_n = Functor_And_Arity(adr); for (i = 0; i < NB_OF_OP; i++) if (arith_tbl[i] == f_n) break; le_word = Arg(adr, 0); re_word = Arg(adr, 1); switch (i) { case PLUS_1: e_word = le_word; goto terminal_rec; case PLUS_2: if (!Pl_Blt_Compound(le_word)) /* try to avoid C stack overflow */ { if (!Normalize(le_word, sign, p)) return FALSE; e_word = re_word; } else { if (!Normalize(re_word, sign, p)) return FALSE; e_word = le_word; } goto terminal_rec; case MINUS_2: if (!Pl_Blt_Compound(le_word)) /* try to avoid C stack overflow */ { if (!Normalize(le_word, sign, p)) return FALSE; e_word = re_word; sign = -sign; } else { if (!Normalize(re_word, -sign, p)) return FALSE; e_word = le_word; } goto terminal_rec; case MINUS_1: e_word = le_word; sign = -sign; goto terminal_rec; case TIMES_2: #ifdef DEVELOP_TIMES_2 #if 1 /* optimize frequent use: INT*VAR */ DEREF(le_word, word, tag_mask); if (tag_mask != TAG_INT_MASK) goto any; n1 = UnTag_INT(word); if (n1 > MAX_COEF_FOR_SORT) sort = TRUE; DEREF(re_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { if (tag_mask != TAG_FDV_MASK) goto any; else { fdv_adr = UnTag_FDV(word); word = Tag_REF(fdv_adr); } } Add_Monom(p, sign, n1, word); return TRUE; any: #endif { Poly p1, p2; int i1, i2; New_Poly(p1); New_Poly(p2); if (!Normalize(le_word, 1, &p1) || !Normalize(re_word, 1, &p2)) return FALSE; Add_Cst_To_Poly(p, sign, p1.c * p2.c); for (i1 = 0; i1 < p1.nb_monom; i1++) { Add_Monom(p, sign, p1.m[i1].a * p2.c, p1.m[i1].x_word); for (i2 = 0; i2 < p2.nb_monom; i2++) if (!Add_Multiply_Monom(p, sign, p1.m + i1, p2.m + i2)) return FALSE; } for (i2 = 0; i2 < p2.nb_monom; i2++) Add_Monom(p, sign, p2.m[i2].a * p1.c, p2.m[i2].x_word); return TRUE; } #else if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = n1 * n2; Add_Cst_To_Poly(p, sign, n1); return TRUE; } Add_Monom(p, sign, n1, word2); return TRUE; } if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); Add_Monom(p, sign, n2, word1); return TRUE; } word1 = (word1 == word2) ? Push_Delayed_Cstr(DC_X2_EQ_Y, word1, 0, 0) : Push_Delayed_Cstr(DC_XY_EQ_Z, word1, word2, 0); Add_Monom(p, sign, 1, word1); return TRUE; #endif case POWER_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if ((n1 = Pl_Power(n1, n2)) < 0) return FALSE; Add_Cst_To_Poly(p, sign, n1); return TRUE; } if (n1 == 1) { Add_Cst_To_Poly(p, sign, 1); return TRUE; } word = (n1 == 0) ? Push_Delayed_Cstr(DC_ZERO_POWER_N_EQ_Y, word2, 0, 0) : Push_Delayed_Cstr(DC_A_POWER_N_EQ_Y, word1, word2, 0); goto end_power; } if (Tag_Mask_Of(word2) != TAG_INT_MASK) Pl_Err_Instantiation(); else { n2 = UnTag_INT(word2); if (n2 == 0) { Add_Cst_To_Poly(p, sign, 1); return TRUE; } word = (n2 == 1) ? word1 : (n2 == 2) ? Push_Delayed_Cstr(DC_X2_EQ_Y, word1, 0, 0) : Push_Delayed_Cstr(DC_X_POWER_A_EQ_Y, word1, word2, 0); } end_power: Add_Monom(p, sign, 1, word); return TRUE; case MIN_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = math_min(n1, n2); Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_MIN_X_A_EQ_Z, word2, word1, 0); goto end_min; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_MIN_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_MIN_X_Y_EQ_Z, word1, word2, 0); end_min: Add_Monom(p, sign, 1, word); return TRUE; case MAX_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = math_max(n1, n2); Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_MAX_X_A_EQ_Z, word2, word1, 0); goto end_max; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_MAX_X_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_MAX_X_Y_EQ_Z, word1, word2, 0); end_max: Add_Monom(p, sign, 1, word); return TRUE; case DIST_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); n1 = (n1 >= n2) ? n1 - n2 : n2 - n1; Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_ABS_X_MINUS_A_EQ_Z, word2, word1, 0); goto end_dist; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_ABS_X_MINUS_A_EQ_Z, word1, word2, 0); else word = Push_Delayed_Cstr(DC_ABS_X_MINUS_Y_EQ_Z, word1, word2, 0); end_dist: Add_Monom(p, sign, 1, word); return TRUE; case QUOT_2: word3 = Make_Self_Ref(H); /* word3 = remainder */ Global_Push(word3); goto quot_rem; case REM_2: word3 = Make_Self_Ref(H); /* word3 = remainder */ Global_Push(word3); goto quot_rem; case QUOT_REM_3: quot_rem: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2) || (i == QUOT_REM_3 && !Load_Term_Into_Word(Arg(adr, 2), &word3))) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0) return FALSE; n3 = n1 % n2; if (i == QUOT_2 || i == QUOT_REM_3) { if (i == QUOT_REM_3) PRIM_CSTR_2(pl_x_eq_c, word3, word); else H--; /* recover word3 space */ n3 = n1 / n2; } Add_Cst_To_Poly(p, sign, n3); return TRUE; } word = Push_Delayed_Cstr(DC_QUOT_REM_A_Y_R_EQ_Z, word1, word2, word3); goto end_quot_rem; } if (Tag_Is_INT(word2)) word = Push_Delayed_Cstr(DC_QUOT_REM_X_A_R_EQ_Z, word1, word2, word3); else word = Push_Delayed_Cstr(DC_QUOT_REM_X_Y_R_EQ_Z, word1, word2, word3); end_quot_rem: Add_Monom(p, sign, 1, (i == REM_2) ? word3 : word); return TRUE; case DIV_2: if (!Load_Term_Into_Word(le_word, &word1) || !Load_Term_Into_Word(re_word, &word2)) return FALSE; if (Tag_Is_INT(word1)) { n1 = UnTag_INT(word1); if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0 || n1 % n2 != 0) return FALSE; n1 /= n2; Add_Cst_To_Poly(p, sign, n1); return TRUE; } word = Push_Delayed_Cstr(DC_DIV_A_Y_EQ_Z, word1, word2, 0); goto end_div; } if (Tag_Is_INT(word2)) { n2 = UnTag_INT(word2); if (n2 == 0) return FALSE; word = Push_Delayed_Cstr(DC_DIV_X_A_EQ_Z, word1, word2, 0); } else word = Push_Delayed_Cstr(DC_DIV_X_Y_EQ_Z, word1, word2, 0); end_div: Add_Monom(p, sign, 1, word); return TRUE; default: word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); goto type_error; } return TRUE; } /*-------------------------------------------------------------------------* * LOAD_POLY * * * * This function loads a polynomial term (without constant) into a word. * * Input: * * nb_monom : nb of monomial terms (nb_monom > 0) * * m : array of monomial terms * * pref_load_word: wanted load_word (or NOT_A_WAM_WORD) * * * * Output: * * load_word : the word containing the loading ie.: <REF,adr> * * * * This functions does not take into account constants. * *-------------------------------------------------------------------------*/ static Bool Load_Poly(int nb_monom, Monom *m, WamWord pref_load_word, WamWord *load_word) { if (nb_monom == 1 && m[0].a == 1) { if (pref_load_word != NOT_A_WAM_WORD) { if (!Pl_Fd_Math_Unify_X_Y(m[0].x_word, pref_load_word)) return FALSE; *load_word = pref_load_word; return TRUE; } *load_word = m[0].x_word; return TRUE; } if (pref_load_word != NOT_A_WAM_WORD) *load_word = pref_load_word; else *load_word = New_Tagged_Fd_Variable; return Load_Poly_Rec(nb_monom, m, *load_word); } /*-------------------------------------------------------------------------* * LOAD_POLY_REC * * * * This function recursively loads a polynomial term into a word. * * Input: * * nb_monom : nb of monomial terms (nb_monom > 0) * * m : array of monomial terms * * load_word : the word where the term must be loaded * * * * At the entry, if nb_monom==1 then the coefficient of the monomial term * * is > 1 (see call from Load_Poly() and recursive call). * *-------------------------------------------------------------------------*/ static Bool Load_Poly_Rec(int nb_monom, Monom *m, WamWord load_word) { WamWord load_word1; if (nb_monom == 1) { /* here m[0].a != 1 */ MATH_CSTR_3(pl_ax_eq_y, Tag_INT(m[0].a), m[0].x_word, load_word); return TRUE; } if (nb_monom == 2) { if (m[0].a == 1) { if (m[1].a == 1) MATH_CSTR_3(pl_x_plus_y_eq_z, m[0].x_word, m[1].x_word, load_word); else MATH_CSTR_4(pl_ax_plus_y_eq_z, Tag_INT(m[1].a), m[1].x_word, m[0].x_word, load_word); } else if (m[1].a == 1) MATH_CSTR_4(pl_ax_plus_y_eq_z, Tag_INT(m[0].a), m[0].x_word, m[1].x_word, load_word); else MATH_CSTR_5(pl_ax_plus_by_eq_z, Tag_INT(m[0].a), m[0].x_word, Tag_INT(m[1].a), m[1].x_word, load_word); return TRUE; } if (nb_monom == 3 && m[2].a == 1) load_word1 = m[2].x_word; else load_word1 = New_Tagged_Fd_Variable; if (m[0].a == 1) { if (m[1].a == 1) MATH_CSTR_4(pl_x_plus_y_plus_z_eq_t, m[0].x_word, m[1].x_word, load_word1, load_word); else MATH_CSTR_5(pl_ax_plus_y_plus_z_eq_t, Tag_INT(m[1].a), m[1].x_word, m[0].x_word, load_word1, load_word); } else if (m[1].a == 1) MATH_CSTR_5(pl_ax_plus_y_plus_z_eq_t, Tag_INT(m[0].a), m[0].x_word, m[1].x_word, load_word1, load_word); else PRIM_CSTR_6(pl_ax_plus_by_plus_z_eq_t, Tag_INT(m[0].a), m[0].x_word, Tag_INT(m[1].a), m[1].x_word, load_word1, load_word); if (!(nb_monom == 3 && m[2].a == 1)) return Load_Poly_Rec(nb_monom - 2, m + 2, load_word1); return TRUE; } /*-------------------------------------------------------------------------* * LOAD_DELAY_CSTR_PART * * * *-------------------------------------------------------------------------*/ static Bool Load_Delay_Cstr_Part(void) { NonLin *i; for (i = delay_cstr_stack; i < delay_sp; i++) { switch (i->cstr) { case DC_X2_EQ_Y: MATH_CSTR_2(pl_x2_eq_y, i->a1, i->res); break; case DC_XY_EQ_Z: MATH_CSTR_3(pl_xy_eq_z, i->a1, i->a2, i->res); break; case DC_DIV_A_Y_EQ_Z: PRIM_CSTR_2(pl_x_gte_c, i->a2, Tag_INT(1)); MATH_CSTR_3(pl_xy_eq_z, i->res, i->a2, i->a1); break; case DC_DIV_X_A_EQ_Z: /* A != 0 has been checked before push in delay stack (see above) */ MATH_CSTR_3(pl_ax_eq_y, i->a2, i->res, i->a1); break; case DC_DIV_X_Y_EQ_Z: PRIM_CSTR_2(pl_x_gte_c, i->a2, Tag_INT(1)); MATH_CSTR_3(pl_xy_eq_z, i->res, i->a2, i->a1); break; case DC_ZERO_POWER_N_EQ_Y: PRIM_CSTR_2(pl_zero_power_n_eq_y, i->a1, i->res); break; case DC_A_POWER_N_EQ_Y: MATH_CSTR_3(pl_a_power_n_eq_y, i->a1, i->a2, i->res); break; case DC_X_POWER_A_EQ_Y: MATH_CSTR_3(pl_x_power_a_eq_y, i->a1, i->a2, i->res); break; case DC_MIN_X_A_EQ_Z: MATH_CSTR_3(pl_min_x_a_eq_z, i->a1, i->a2, i->res); break; case DC_MIN_X_Y_EQ_Z: MATH_CSTR_3(pl_min_x_y_eq_z, i->a1, i->a2, i->res); break; case DC_MAX_X_A_EQ_Z: MATH_CSTR_3(pl_max_x_a_eq_z, i->a1, i->a2, i->res); break; case DC_MAX_X_Y_EQ_Z: MATH_CSTR_3(pl_max_x_y_eq_z, i->a1, i->a2, i->res); break; case DC_ABS_X_MINUS_A_EQ_Z: MATH_CSTR_3(pl_abs_x_minus_a_eq_z, i->a1, i->a2, i->res); break; case DC_ABS_X_MINUS_Y_EQ_Z: MATH_CSTR_3(pl_abs_x_minus_y_eq_z, i->a1, i->a2, i->res); break; case DC_QUOT_REM_A_Y_R_EQ_Z: MATH_CSTR_4(pl_quot_rem_a_y_r_eq_z, i->a1, i->a2, i->a3, i->res); break; case DC_QUOT_REM_X_A_R_EQ_Z: MATH_CSTR_4(pl_quot_rem_x_a_r_eq_z, i->a1, i->a2, i->a3, i->res); break; case DC_QUOT_REM_X_Y_R_EQ_Z: MATH_CSTR_4(pl_quot_rem_x_y_r_eq_z, i->a1, i->a2, i->a3, i->res); break; } } delay_sp = delay_cstr_stack; return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_MATH_UNIFY_X_Y * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Math_Unify_X_Y(WamWord x, WamWord y) { WamWord x_word, x_tag; WamWord y_word, y_tag; DEREF(x, x_word, x_tag); DEREF(y, y_word, y_tag); if (x_tag == TAG_FDV_MASK && y_tag == TAG_FDV_MASK) { MATH_CSTR_2(pl_x_eq_y, x, y); return TRUE; } #ifdef DEBUG DBGPRINTF("Prolog Unif: "); Pl_Write_1(x_word); DBGPRINTF(" = "); Pl_Write_1(y_word); DBGPRINTF("\n"); #endif return Pl_Unify(x_word, y_word); } /*-------------------------------------------------------------------------* * X_EQ_C * * * * Defined here instead in fd_math_fd.fd to avoid A frame creation. * *-------------------------------------------------------------------------*/ Bool pl_x_eq_c(WamWord x, WamWord c) { return Pl_Get_Integer_Tagged(c, x); } #ifdef DEBUG /*-------------------------------------------------------------------------* * DEBUG_DISPLAY * * * *-------------------------------------------------------------------------*/ void Debug_Display(char *fct, int n, ...) { va_list arg_ptr; WamWord word; int i; char *s1[] = { "plus", "eq", "neq", "lte", "lt", "gte", "gt", NULL }; char *s2[] = { "+", "=", "\\=", "<=", "<", ">=", ">" }; char **s; char *p; va_start(arg_ptr, n); DBGPRINTF("'"); for (p = fct; *p; p++) { if (*p == '_') { for (s = s1; *s; s++) { i = strlen(*s); if (strncmp(*s, p + 1, i) == 0) break; } if (*s && p[1 + i] == '_') { p += 1 + i; DBGPRINTF("%s", s2[s - s1]); continue; } } DBGPRINTF("%c", *p); } DBGPRINTF("'("); for (i = 0; i < n; i++) { word = va_arg(arg_ptr, WamWord); Pl_Write_1(word); DBGPRINTF("%c", (i < n - 1) ? ',' : ')'); } va_end(arg_ptr); DBGPRINTF("\n"); } #endif ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/oper_supp.h����������������������������������������������������������������0000644�0001750�0001750�00000007651�13021324543�015413� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : oper_supp.h * * Descr.: FD Operation support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ unsigned Pl_Power(unsigned x, unsigned n); unsigned Pl_Nth_Root_Dn(unsigned y, unsigned n); unsigned Pl_Nth_Root_Up(unsigned y, unsigned n); unsigned Pl_Nth_Root_Exact(unsigned y, unsigned n); unsigned Pl_Sqrt_Dn(unsigned y); unsigned Pl_Sqrt_Up(unsigned y); unsigned Pl_Sqrt_Exact(unsigned y); unsigned Pl_Find_Expon_Dn(unsigned x, unsigned y); unsigned Pl_Find_Expon_Up(unsigned x, unsigned y); unsigned Pl_Find_Expon_Exact(unsigned x, unsigned y); void Pl_Full_Coeff_Power_Var(Range *y, int a, Range *n); void Pl_Full_Find_Expon(Range *n, int a, Range *y); void Pl_Full_Var_Power_Coeff(Range *y, Range *x, int a); void Pl_Full_Nth_Root(Range *x, Range *y, int a); void Full_Max_Cst_Var(Range *z, int a, Range *x); void Full_Min_Cst_Var(Range *z, int a, Range *x); ���������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_symbolic.pl�������������������������������������������������������������0000644�0001750�0001750�00000010314�13021324543�016043� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_symbolic.pl * * Descr.: symbolic constraints management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_symbolic'. fd_all_different(L) :- set_bip_name(fd_all_different, 1), '$call_c_test'('Pl_Fd_All_Different_1'(L, L)). fd_element(I, List, V) :- set_bip_name(fd_element, 3), '$fd_element'(I, List, V). '$fd_element'(I, List, V) :- fd_tell(pl_fd_element(I, List, V)). fd_element_var(I, List, V) :- set_bip_name(fd_element_var, 3), fd_tell(pl_fd_element_var(I, List, V)). fd_atmost(N, List, V) :- set_bip_name(fd_atmost, 3), fd_tell(pl_fd_atmost(N, List, V)). fd_atleast(N, List, V) :- set_bip_name(fd_atleast, 3), fd_tell(pl_fd_atleast(N, List, V)). fd_exactly(N, List, V) :- set_bip_name(fd_exactly, 3), fd_tell(pl_fd_exactly(N, List, V)). fd_relation(Tuples, Vars) :- set_bip_name(fd_relation, 2), '$check_list'(Tuples), '$check_list_or_partial_list'(Vars), '$lines_to_columns'(Tuples, CTuples), '$fd_relationc1'(CTuples, Vars, _). fd_relationc(CTuples, Vars) :- set_bip_name(fd_relationc, 2), '$check_list'(CTuples), '$check_list_or_partial_list'(Vars), '$fd_relationc1'(CTuples, Vars, _). '$fd_relationc1'([], [], _). '$fd_relationc1'([C|CTuples], [X|Vars], R) :- '$fd_element'(R, C, X), '$fd_relationc1'(CTuples, Vars, R). '$lines_to_columns'([[]|_], []) :- !. '$lines_to_columns'(Tuples, [Column|Columns]) :- '$create_column'(Tuples, Column, Tuples1), '$lines_to_columns'(Tuples1, Columns). '$create_column'([], [], []). '$create_column'([[X|L]|Tuples], [X|Column], [L|Tuples1]) :- '$create_column'(Tuples, Column, Tuples1). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_symbolic_fd.fd����������������������������������������������������������0000644�0001750�0001750�00000007227�13021324543�016503� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_symbolic_fd.fd * * Descr.: symbolic constraints management - FD part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ %{ Bool Pl_Fd_Element_V_To_Xi(int i, WamWord *array, Range *v); Bool Pl_Fd_Atmost(int n, WamWord *array, int v); Bool Pl_Fd_Atleast(int n, WamWord *array, int v); Bool Pl_Fd_Exactly(int n, WamWord *array, int v); %} pl_fd_element(fdv I, l_int L, fdv V) { start I in Pl_Fd_Element_I(L) start V in Pl_Fd_Element_I_To_V(dom(I), L) start I in Pl_Fd_Element_V_To_I(dom(V), L) } pl_fd_element_var(fdv I, l_fdv L, fdv V) { start I in Pl_Fd_Element_Var_I(L) start V in Pl_Fd_Element_Var_I_To_V(dom(I), L) trigger also on dom(L) start I in Pl_Fd_Element_Var_V_To_I(dom(V), L) trigger also on dom(L) start Pl_Fd_Element_V_To_Xi(val(I), L, dom(V)) } pl_fd_atmost(int N, l_fdv L, int V) { start Pl_Fd_Atmost(N, L, V) trigger on dom(L) always } pl_fd_atleast(int N, l_fdv L, int V) { start Pl_Fd_Atleast(N, L, V) trigger on dom(L) always } pl_fd_exactly(int N, l_fdv L, int V) { start Pl_Fd_Exactly(N, L, V) trigger on dom(L) always } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_values_c.c��������������������������������������������������������������0000644�0001750�0001750�00000047531�13021324543�015645� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_values_c.c * * Descr.: FD variable values management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ #define METHOD_MIN 0 #define METHOD_MAX 1 #define METHOD_RANDOM_V 2 #define METHOD_MIDDLE 3 #define METHOD_BISECT 4 #define METHOD_LIMITS 5 #define METHOD_LIMITS_MIN METHOD_LIMITS #define METHOD_LIMITS_MAX (METHOD_LIMITS + 1) #define METHOD_STANDARD 0 #define METHOD_FIRST_FAIL 1 #define METHOD_MOST_CONSTRAINED 2 #define METHOD_SMALLEST 3 #define METHOD_LARGEST 4 #define METHOD_MAX_REGRET 5 #define METHOD_RANDOM 6 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef Bool (*CmpFct) (); /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Cmp_First_Fail(WamWord *last_fdv_adr, WamWord *new_fdv_adr); static Bool Cmp_Most_Constrained(WamWord *last_fdv_adr, WamWord *new_fdv_adr); static Bool Cmp_Smallest(WamWord *last_fdv_adr, WamWord *new_fdv_adr); static Bool Cmp_Largest(WamWord *last_fdv_adr, WamWord *new_fdv_adr); static Bool Cmp_Max_Regret(WamWord *last_fdv_adr, WamWord *new_fdv_adr); #define INDOMAIN_ALT X1_24696E646F6D61696E5F616C74 #define EXTRA_CSTR_ALT X1_2465787472615F637374725F616C74 Prolog_Prototype(INDOMAIN_ALT, 0); Prolog_Prototype(EXTRA_CSTR_ALT, 0); /* defined in fd_values_fd.fd */ Bool pl_fd_domain_r(WamWord x_word, WamWord r_word); /*-------------------------------------------------------------------------* * PL_FD_DOMAIN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Domain_2(WamWord list_word, WamWord r_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_INT_MASK || tag_mask == TAG_FDV_MASK) return pl_fd_domain_r(word, r_word); save_list_word = list_word; for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); if (!pl_fd_domain_r(Car(lst_adr), r_word)) return FALSE; list_word = Cdr(lst_adr); } return TRUE; } /* domain(X,L,U) is optimized here. * Previously it called pl_fd_domain (defined in fd_values_fd.fd as X in L..U) * This version avoids AFrame creation and FD var creation if interval is empty or an INT * * We do not do the same for domain(X,L) (which continues to call pl_fd_domain_r) * Because we have to be cautious when handling range directly (see Pl_Tell_Range_Range * which recovers CS/save_CS). Also to avoid to handle extra cstr warning messages * (for instance when a range is empty or a singleton and extr_cstr is TRUE). * * The 2 following functions could be moved to EngineFD/fd_inst.c (is often use): * Pl_Fd_Domain_Interval * Pl_Fd_Domain_Var_3 (renamed as Pl_Fd_Prolog_Domain) * */ /*-------------------------------------------------------------------------* * Pl_FD_DOMAIN_INTERVAL * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Domain_Interval(WamWord x_word, int min, int max) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; PlLong v; DEREF(x_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { if (min > max) return FALSE; if (min == max) return Pl_Get_Integer(min, x_word); adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Variable_Interval(min, max); Bind_UV(adr, Tag_REF(fdv_adr)); return TRUE; } if (tag_mask == TAG_INT_MASK) { v = UnTag_INT(word); return (v >= min && v <= max); /* also detects if min > max */ } if (tag_mask != TAG_FDV_MASK) Pl_Err_Type(pl_type_fd_variable, word); return Pl_Fd_In_Interval(UnTag_FDV(word), min, max); } /*-------------------------------------------------------------------------* * PL_FD_DOMAIN_VAR_3 * * * * Only accepts a var (not a list) * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Domain_Var_3(WamWord x_word, WamWord l_word, WamWord u_word) { int min, max; min = Pl_Fd_Prolog_To_Value(l_word); if (min < 0) min = 0; max = Pl_Fd_Prolog_To_Value(u_word); return Pl_Fd_Domain_Interval(x_word, min, max); } /*-------------------------------------------------------------------------* * PL_FD_DOMAIN_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Domain_3(WamWord list_word, WamWord l_word, WamWord u_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; int min, max; min = Pl_Fd_Prolog_To_Value(l_word); if (min < 0) min = 0; max = Pl_Fd_Prolog_To_Value(u_word); DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_INT_MASK || tag_mask == TAG_FDV_MASK) return Pl_Fd_Domain_Interval(word, min, max); save_list_word = list_word; for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); if (!Pl_Fd_Domain_Interval(Car(lst_adr), min, max)) return FALSE; list_word = Cdr(lst_adr); } return TRUE; } /*-------------------------------------------------------------------------* * SELECT_VALUE * * * *-------------------------------------------------------------------------*/ static int Select_Value(WamWord *fdv_adr, int value_method) { int n; switch(value_method) { case METHOD_MIN: case METHOD_LIMITS_MIN: return Min(fdv_adr); case METHOD_MAX: case METHOD_LIMITS_MAX: return Max(fdv_adr); case METHOD_BISECT: case METHOD_MIDDLE: n = Nb_Elem(fdv_adr) / 2; /* here nb_elem > 1 => n >= 1 */ return Pl_Range_Ith_Elem(Range(fdv_adr), n); /* Ith is in 1..nb_elem */ case METHOD_RANDOM_V: n = Nb_Elem(fdv_adr); n = Pl_M_Random_Integer(n); /* random returns in 0..nb_elem-1 */ return Pl_Range_Ith_Elem(Range(fdv_adr), n + 1); /* Ith is in 1..nb_elem */ } return 0; } /*-------------------------------------------------------------------------* * PL_INDOMAIN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Indomain_2(WamWord x_word, WamWord method_word) { WamWord word, tag_mask; WamWord *fdv_adr; int value_method; int value; value_method = Pl_Rd_Integer(method_word); Fd_Deref_Check_Fd_Var(x_word, word, tag_mask); fdv_adr = UnTag_FDV(word); bisect_terminal_rec: if (tag_mask == TAG_INT_MASK) return TRUE; value = Select_Value(fdv_adr, value_method); A(0) = (WamWord) fdv_adr | Extra_Cstr(fdv_adr); A(1) = value_method; A(2) = value; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(INDOMAIN_ALT, 0), 3); if (value_method == METHOD_BISECT) { if (!Pl_Fd_In_Interval(fdv_adr, 0, value)) return FALSE; tag_mask = Tag_Mask_Of(*fdv_adr); goto bisect_terminal_rec; } return Pl_Fd_Assign_Value_Fast(fdv_adr, value); } /*-------------------------------------------------------------------------* * PL_INDOMAIN_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Indomain_Alt_0(void) { WamWord *fdv_adr; int extra_cstr; int value_method; int value; Pl_Delete_Choice_Point(3); SYS_VAR_FD_BCKTS++; fdv_adr = (WamWord *) (A(0) & ~1); extra_cstr = A(0) & 1; value_method = A(1); value = A(2); if (value_method == METHOD_LIMITS_MIN) value_method = METHOD_LIMITS_MAX; else if (value_method == METHOD_LIMITS_MAX) value_method = METHOD_LIMITS_MIN; else if (value_method == METHOD_BISECT) { /* NB: not need to test extra_cstr because it is handled by Pl_Fd_In_Interval() * (when the var becomes ground or if empty domain (failure) */ if (!Pl_Fd_In_Interval(fdv_adr, value + 1, INTERVAL_MAX_INTEGER)) return FALSE; /* simple and enough (like in Prolog) */ return Pl_Indomain_2(*fdv_adr, Tag_INT(value_method)); } if (!Pl_Fd_Remove_Value(fdv_adr, value)) { if (extra_cstr) Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } if (Tag_Mask_Of(*fdv_adr) == TAG_INT_MASK) { if (extra_cstr) { /* A(0) = fdv_adr; */ Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(EXTRA_CSTR_ALT, 0), 1); } return TRUE; } value = Select_Value(fdv_adr, value_method); /* A(0) = (WamWord) fdv_adr | Extra_Cstr(fdv_adr); */ A(1) = value_method; /* can change for METHOD_LIMITS */ A(2) = value; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(INDOMAIN_ALT, 0), 3); return Pl_Fd_Assign_Value_Fast(fdv_adr, value); } /*-------------------------------------------------------------------------* * PL_EXTRA_CSTR_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Extra_Cstr_Alt_0(void) { WamWord *fdv_adr; fdv_adr = (WamWord *) AB(B, 0); Pl_Delete_Choice_Point(0); Pl_Fd_Display_Extra_Cstr(fdv_adr); return FALSE; } /*-------------------------------------------------------------------------* * PL_FD_SEL_ARRAY_FROM_LIST_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Sel_Array_From_List_2(WamWord list_word, WamWord sel_array_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; int n = 0; WamWord *fdv_adr; WamWord *array; WamWord *save_array; array = CS; save_list_word = list_word; save_array = array; array++; /* +1 for the nb of elems */ for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_fd_variable, word); if (tag_mask == TAG_FDV_MASK) { fdv_adr = UnTag_FDV(word); *array++ = (WamWord) fdv_adr; n++; } list_word = Cdr(lst_adr); } *save_array = n; CS = array; return Pl_Get_Integer(Cstr_Offset(save_array), sel_array_word); } /*-------------------------------------------------------------------------* * PL_FD_SEL_ARRAY_PICK_VAR_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Sel_Array_Pick_Var_4(WamWord sel_array_word, WamWord method_word, WamWord reorder_word, WamWord fdv_word) #if 1 #define PACK_ARRAY #endif { WamWord **array; WamWord **p, **end; CmpFct cmp_meth; PlLong n; int i; WamWord *fdv_adr; WamWord **res_elem = NULL; Bool reorder; #ifdef PACK_ARRAY WamWord **q; int nb_ground = 0; #endif array = (WamWord **) (Cstr_Stack + Pl_Rd_Integer_Check(sel_array_word)); n = (PlLong) array[0]; if (n == 0) return FALSE; array++; end = array + n; reorder = Pl_Rd_Integer_Check(reorder_word); switch (Pl_Rd_Integer_Check(method_word)) { case METHOD_FIRST_FAIL: cmp_meth = Cmp_First_Fail; break; case METHOD_MOST_CONSTRAINED: cmp_meth = Cmp_Most_Constrained; break; case METHOD_SMALLEST: cmp_meth = Cmp_Smallest; break; case METHOD_LARGEST: cmp_meth = Cmp_Largest; break; case METHOD_MAX_REGRET: cmp_meth = Cmp_Max_Regret; break; case METHOD_RANDOM: for (;;) { i = Pl_M_Random_Integer(n); end--; n--; fdv_adr = array[i]; array[i] = *end; *end = fdv_adr; if (!Fd_Variable_Is_Ground(fdv_adr)) { Trail_OV(array - 1); array[-1] = (WamWord *) n; goto finish; } if (n == 0) return FALSE; } } for (p = array; p < end; p++) { fdv_adr = *p; if (!Fd_Variable_Is_Ground(fdv_adr)) { if (res_elem == NULL) res_elem = p; else if ((*cmp_meth) (*res_elem, fdv_adr)) { if (reorder) { *p = *res_elem; *res_elem = fdv_adr; } else res_elem = p; } } #ifdef PACK_ARRAY else nb_ground++; #endif } if (res_elem == NULL) return FALSE; #ifdef PACK_ARRAY if (n > 50 && nb_ground >= n / 2) { n = n - nb_ground; Trail_MV(array - 1, n + 1); array[-1] = (WamWord *) n; for (p = q = array; n; p++) { fdv_adr = *p; if (!Fd_Variable_Is_Ground(fdv_adr)) { *q++ = *p; n--; } } } #endif fdv_adr = *res_elem; finish: return Pl_Unify(Tag_REF(fdv_adr), fdv_word); } /*-------------------------------------------------------------------------* * CMP_FIRST_FAIL * * * *-------------------------------------------------------------------------*/ static Bool Cmp_First_Fail(WamWord *last_fdv_adr, WamWord *new_fdv_adr) { return Nb_Elem(new_fdv_adr) < Nb_Elem(last_fdv_adr); } /*-------------------------------------------------------------------------* * CMP_MOST_CONSTRAINED * * * *-------------------------------------------------------------------------*/ static Bool Cmp_Most_Constrained(WamWord *last_fdv_adr, WamWord *new_fdv_adr) { int l_nb = Nb_Elem(last_fdv_adr); int n_nb = Nb_Elem(new_fdv_adr); return n_nb < l_nb || (n_nb == l_nb && Nb_Cstr(new_fdv_adr) > Nb_Cstr(last_fdv_adr)); } /*-------------------------------------------------------------------------* * CMP_SMALLEST * * * *-------------------------------------------------------------------------*/ static Bool Cmp_Smallest(WamWord *last_fdv_adr, WamWord *new_fdv_adr) { int l_min = Min(last_fdv_adr); int n_min = Min(new_fdv_adr); return n_min < l_min || (n_min == l_min && Nb_Cstr(new_fdv_adr) > Nb_Cstr(last_fdv_adr)); } /*-------------------------------------------------------------------------* * CMP_LARGEST * * * *-------------------------------------------------------------------------*/ static Bool Cmp_Largest(WamWord *last_fdv_adr, WamWord *new_fdv_adr) { int l_max = Max(last_fdv_adr); int n_max = Max(new_fdv_adr); return n_max > l_max || (n_max == l_max && Nb_Cstr(new_fdv_adr) > Nb_Cstr(last_fdv_adr)); } /*-------------------------------------------------------------------------* * CMP_MAX_REGRET * * * *-------------------------------------------------------------------------*/ static Bool Cmp_Max_Regret(WamWord *last_fdv_adr, WamWord *new_fdv_adr) { int l_diff; int n_diff; int min; min = Min(last_fdv_adr); l_diff = Pl_Range_Next_After(Range(last_fdv_adr), min) - min; min = Min(new_fdv_adr); n_diff = Pl_Range_Next_After(Range(new_fdv_adr), min) - min; return n_diff > l_diff || (n_diff == l_diff && Nb_Cstr(new_fdv_adr) > Nb_Cstr(last_fdv_adr)); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_bool_c.c����������������������������������������������������������������0000644�0001750�0001750�00000126064�13021324543�015300� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_bool_c.c * * Descr.: boolean and Meta-constraint predicate management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define OBJ_INIT Fd_Bool_Initializer #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ #define BOOL_STACK_SIZE 100000 #define VARS_STACK_SIZE 100000 #define NOT 0 #define EQUIV 1 #define NEQUIV 2 #define IMPLY 3 #define NIMPLY 4 #define AND 5 #define NAND 6 #define OR 7 #define NOR 8 #define EQ 9 /* warning EQ must have same */ #define NEQ 10 /* parity than EQ_F and ZERO */ #define LT 11 #define GTE 12 #define GT 13 #define LTE 14 #define EQ_F 15 #define NEQ_F 16 #define LT_F 17 #define GTE_F 18 #define GT_F 19 #define LTE_F 20 #define ZERO 21 #define ONE 22 /* must be last */ #define IsVar(op) ((op)>=ONE) #define NB_OF_OP ZERO /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord bool_tbl[NB_OF_OP]; static WamWord bool_xor; static WamWord stack[BOOL_STACK_SIZE]; static WamWord *sp; static WamWord vars_tbl[VARS_STACK_SIZE]; static WamWord *vars_sp; static Bool (*func_tbl[NB_OF_OP + 2]) (WamWord *exp, int result, WamWord *load_word); /*---------------------------------* * Function Prototypes * *---------------------------------*/ static WamWord *Simplify(int sign, WamWord e_word); static void Add_Fd_Variables(WamWord e_word); static Bool Load_Bool_Into_Word(WamWord *exp, int result, WamWord *load_word); static Bool Set_Var(WamWord *exp, int result, WamWord *load_word); static Bool Set_Not(WamWord *exp, int result, WamWord *load_word); static Bool Set_Equiv(WamWord *exp, int result, WamWord *load_word); static Bool Set_Nequiv(WamWord *exp, int result, WamWord *load_word); static Bool Set_Imply(WamWord *exp, int result, WamWord *load_word); static Bool Set_Nimply(WamWord *exp, int result, WamWord *load_word); static Bool Set_And(WamWord *exp, int result, WamWord *load_word); static Bool Set_Nand(WamWord *exp, int result, WamWord *load_word); static Bool Set_Or(WamWord *exp, int result, WamWord *load_word); static Bool Set_Nor(WamWord *exp, int result, WamWord *load_word); static Bool Set_Eq(WamWord *exp, int result, WamWord *load_word); static Bool Set_Neq(WamWord *exp, int result, WamWord *load_word); static Bool Set_Lt(WamWord *exp, int result, WamWord *load_word); static Bool Set_Lte(WamWord *exp, int result, WamWord *load_word); static Bool Set_Zero(WamWord *exp, int result, WamWord *load_word); static Bool Set_One(WamWord *exp, int result, WamWord *load_word); #ifdef DEBUG static void Display_Stack(WamWord *exp); void Pl_Write_1(WamWord term_word); #endif /* defined in fd_math_c.c */ Bool Pl_Fd_Eq_2(WamWord le_word, WamWord re_word); Bool Pl_Fd_Neq_2(WamWord le_word, WamWord re_word); Bool Pl_Fd_Lt_2(WamWord le_word, WamWord re_word); Bool Pl_Fd_Lte_2(WamWord le_word, WamWord re_word); #define BOOL_CSTR_2(f, a1, a2) \ do \ { \ if (!Pl_Fd_Check_For_Bool_Var(a1)) \ return FALSE; \ if (!Pl_Fd_Check_For_Bool_Var(a2)) \ return FALSE; \ PRIM_CSTR_2(f, a1, a2); \ } \ while (0) #define BOOL_CSTR_3(f, a1, a2, a3) \ do \ { \ if (!Pl_Fd_Check_For_Bool_Var(a1)) \ return FALSE; \ if (!Pl_Fd_Check_For_Bool_Var(a2)) \ return FALSE; \ /* a3 is OK */ \ PRIM_CSTR_3(f, a1, a2, a3); \ } \ while (0) /*-------------------------------------------------------------------------* * FD_BOOL_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Fd_Bool_Initializer(void) { bool_tbl[NOT] = Functor_Arity(Pl_Create_Atom("#\\"), 1); bool_tbl[EQUIV] = Functor_Arity(Pl_Create_Atom("#<=>"), 2); bool_tbl[NEQUIV] = Functor_Arity(Pl_Create_Atom("#\\<=>"), 2); bool_tbl[IMPLY] = Functor_Arity(Pl_Create_Atom("#==>"), 2); bool_tbl[NIMPLY] = Functor_Arity(Pl_Create_Atom("#\\==>"), 2); bool_tbl[AND] = Functor_Arity(Pl_Create_Atom("#/\\"), 2); bool_tbl[NAND] = Functor_Arity(Pl_Create_Atom("#\\/\\"), 2); bool_tbl[OR] = Functor_Arity(Pl_Create_Atom("#\\/"), 2); bool_tbl[NOR] = Functor_Arity(Pl_Create_Atom("#\\\\/"), 2); bool_tbl[EQ] = Functor_Arity(Pl_Create_Atom("#="), 2); bool_tbl[NEQ] = Functor_Arity(Pl_Create_Atom("#\\="), 2); bool_tbl[LT] = Functor_Arity(Pl_Create_Atom("#<"), 2); bool_tbl[GTE] = Functor_Arity(Pl_Create_Atom("#>="), 2); bool_tbl[GT] = Functor_Arity(Pl_Create_Atom("#>"), 2); bool_tbl[LTE] = Functor_Arity(Pl_Create_Atom("#=<"), 2); bool_tbl[EQ_F] = Functor_Arity(Pl_Create_Atom("#=#"), 2); bool_tbl[NEQ_F] = Functor_Arity(Pl_Create_Atom("#\\=#"), 2); bool_tbl[LT_F] = Functor_Arity(Pl_Create_Atom("#<#"), 2); bool_tbl[GTE_F] = Functor_Arity(Pl_Create_Atom("#>=#"), 2); bool_tbl[GT_F] = Functor_Arity(Pl_Create_Atom("#>#"), 2); bool_tbl[LTE_F] = Functor_Arity(Pl_Create_Atom("#=<#"), 2); bool_xor = Functor_Arity(Pl_Create_Atom("##"), 2); func_tbl[NOT] = Set_Not; func_tbl[EQUIV] = Set_Equiv; func_tbl[NEQUIV] = Set_Nequiv; func_tbl[IMPLY] = Set_Imply; func_tbl[NIMPLY] = Set_Nimply; func_tbl[AND] = Set_And; func_tbl[NAND] = Set_Nand; func_tbl[OR] = Set_Or; func_tbl[NOR] = Set_Nor; func_tbl[EQ] = Set_Eq; func_tbl[NEQ] = Set_Neq; func_tbl[LT] = Set_Lt; func_tbl[GTE] = NULL; func_tbl[GT] = NULL; func_tbl[LTE] = Set_Lte; func_tbl[EQ_F] = NULL; func_tbl[NEQ_F] = NULL; func_tbl[LT_F] = NULL; func_tbl[GTE_F] = NULL; func_tbl[GT_F] = NULL; func_tbl[LTE_F] = NULL; func_tbl[ZERO] = Set_Zero; func_tbl[ONE] = Set_One; } /*-------------------------------------------------------------------------* * PL_FD_BOOL_META_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Bool_Meta_3(WamWord le_word, WamWord re_word, WamWord op_word) { WamWord word, tag_mask; WamWord *adr, *fdv_adr; WamWord *exp; int op; static WamWord h[3]; /* static to avoid high address */ DEREF(op_word, word, tag_mask); op = UnTag_INT(op_word); h[0] = bool_tbl[op]; /* also works for NOT/1 */ h[1] = le_word; h[2] = re_word; sp = stack; vars_sp = vars_tbl; exp = Simplify(1, Tag_STC(h)); #ifdef DEBUG Display_Stack(exp); DBGPRINTF("\n"); #endif if (!Load_Bool_Into_Word(exp, 1, NULL)) return FALSE; while (--vars_sp >= vars_tbl) if (*vars_sp-- == 0) /* bool var */ { if (!Pl_Fd_Check_For_Bool_Var(*vars_sp)) return FALSE; } else /* FD var */ { DEREF(*vars_sp, word, tag_mask); if (tag_mask == TAG_REF_MASK) { adr = UnTag_REF(word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); } } return TRUE; } /*-------------------------------------------------------------------------* * SIMPLIFY * * * * This function returns the result of the simplified boolean expression * * given in e_word. NOT operators are only applied to variables. * * * * Input: * * sign : current sign of the boolean term (-1 (inside a ~) or +1) * * e_word: boolean term to simplify * * * * Output: * * The returned result is a pointer to a node of the following form: * * * * for binary boolean not operator (~): * * [1]: variable involved (tagged word) * * [0]: operator NOT * * * * for unary boolean operators (<=> ~<=> ==> ~==> /\ ~/\ \/ ~\/): * * [2]: right boolean exp (pointer to node) * * [1]: left boolean exp (pointer to node) * * [0]: operator (EQUIV, NEQUIV, IMPLY, NIMPLY, AND, NAND, OR, NOR) * * * * for boolean false value (0): * * [0]: ZERO * * * * for boolean true value (1): * * [0]: ONE * * * * for boolean variable: * * [0]: tagged word * * * * for binary math operators (= \= < >= > <=) (partial / full AC): * * [2]: right math exp (tagged word) * * [1]: left math exp (tagged word) * * [0]: operator (EQ, NEQ, LT, LTE, EQ_F, NEQ_F, LT_F, LTE_F) * * (GT, GTE, GT_F, and GTE_F becomes LT, LTE, LT_F and LTE_F) * * * * These nodes are stored in a hybrid stack. NB: XOR same as NEQUIV * *-------------------------------------------------------------------------*/ static WamWord * Simplify(int sign, WamWord e_word) { WamWord word, tag_mask; WamWord *adr; WamWord f_n, le_word, re_word; int op, n; WamWord *exp, *sp1; WamWord l, r; #ifdef DEBUG printf("ENTERING %5ld: %2d: ", sp - stack, sign); Pl_Write(e_word); printf("\n"); #endif exp = sp; if (sp - stack > BOOL_STACK_SIZE - 5) Pl_Err_Resource(pl_resource_too_big_fd_constraint); DEREF(e_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_FDV_MASK) { adr = UnTag_Address(word); if (vars_sp - vars_tbl == VARS_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); *vars_sp++ = word; *vars_sp++ = 0; /* bool var */ if (sign != 1) *sp++ = NOT; *sp++ = Tag_REF(adr); return exp; } if (tag_mask == TAG_INT_MASK) { n = UnTag_INT(word); if ((unsigned) n > 1) goto type_error; *sp++ = ZERO + ((sign == 1) ? n : 1 - n); return exp; } if (tag_mask == TAG_ATM_MASK) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(e_word); Pl_Unify_Integer(0); type_error: Pl_Err_Type(pl_type_fd_bool_evaluable, word); } if (tag_mask != TAG_STC_MASK) goto type_error; adr = UnTag_STC(word); f_n = Functor_And_Arity(adr); if (bool_xor == f_n) op = NEQUIV; else { for (op = 0; op < NB_OF_OP; op++) if (bool_tbl[op] == f_n) break; if (op == NB_OF_OP) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); goto type_error; } } le_word = Arg(adr, 0); re_word = Arg(adr, 1); if (op == NOT) return Simplify(-sign, le_word); if (sign != 1) op = (op % 2 == EQ % 2) ? op + 1 : op - 1; if (op >= EQ && op <= LTE_F) { Add_Fd_Variables(le_word); Add_Fd_Variables(re_word); n = (op == GT || op == GT_F) ? op - 2 : (op == GTE || op == GTE_F) ? op + 2 : op; *sp++ = n; *sp++ = (n == op) ? le_word : re_word; *sp++ = (n == op) ? re_word : le_word; return exp; } sp += 3; exp[0] = op; exp[1] = (WamWord) Simplify(1, le_word); sp1 = sp; exp[2] = (WamWord) Simplify(1, re_word); l = *(WamWord *) (exp[1]); r = *(WamWord *) (exp[2]); /* NB: beware when calling below Simplify() (while has been just called above) * this can ran into stack overflow (N^2 space complexity). * Try to recover the stack before calling Simplify(). * Other stack recovery are less important (e.g. when only using exp[1]). * * In the following exp[] += sizeof(WamWord) is used to "skip" the NOT * in a simplification (points to the next cell). */ switch (op) { case EQUIV: if (l == ZERO) /* 0 <=> R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (l == ONE) /* 1 <=> R is R */ { return (WamWord *) exp[2]; } if (r == ZERO) /* L <=> 0 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (r == ONE) /* L <=> 1 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X <=> R is X <=> ~R */ { exp[1] += sizeof(WamWord); sp = sp1; exp[2] = (WamWord) Simplify(-1, re_word); break; } if (r == NOT) /* L <=> ~X is ~L <=> X */ { /* NB: cannot recover the stack */ exp[1] = (WamWord) Simplify(-1, le_word); exp[2] += sizeof(WamWord); break; } break; case NEQUIV: if (l == ZERO) /* 0 ~<=> R is R */ { return (WamWord *) exp[2]; } if (l == ONE) /* 1 ~<=> R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ZERO) /* L ~<=> 0 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (r == ONE) /* L ~<=> 1 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (l == NOT) /* ~X ~<=> R is X <=> R */ { exp[0] = EQUIV; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ~<=> ~X is L <=> X */ { exp[0] = EQUIV; exp[2] += sizeof(WamWord); break; } if (IsVar(l) && !IsVar(r)) /* X ~<=> R is X <=> ~R */ { exp[0] = EQUIV; sp = sp1; exp[2] = (WamWord) Simplify(-1, re_word); break; } if (IsVar(r) && !IsVar(l)) /* L ~<=> X is L <=> ~X */ { exp[0] = EQUIV; /* NB: cannot recover the stack */ exp[1] = (WamWord) Simplify(-1, le_word); break; } break; case IMPLY: if (l == ZERO || r == ONE) /* 0 ==> R is 1 , L ==> 1 is 1 */ { sp = exp; *sp++ = ONE; break; } if (l == ONE) /* 1 ==> R is R */ { return (WamWord *) exp[2]; } if (r == ZERO) /* L ==> 0 is ~L */ return sp = exp, Simplify(-1, le_word); if (l == NOT) /* ~X ==> R is X \/ R */ { exp[0] = OR; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ==> ~X is X ==> ~L */ { exp[1] = exp[2] + sizeof(WamWord); exp[2] = (WamWord) Simplify(-1, le_word); break; } break; case NIMPLY: if (l == ZERO || r == ONE) /* 0 ~==> R is 0 , L ~==> 1 is 0 */ { sp = exp; *sp++ = ZERO; break; } if (l == ONE) /* 1 ~==> R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ZERO) /* L ~==> 0 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X ~==> R is X ~\/ R */ { exp[0] = NOR; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ~==> ~X is L /\ X */ { exp[0] = AND; exp[2] += sizeof(WamWord); break; } break; case AND: if (l == ZERO || r == ZERO) /* 0 /\ R is 0 , L /\ 0 is 0 */ { sp = exp; *sp++ = ZERO; break; } if (l == ONE) /* 1 /\ R is R */ { return (WamWord *) exp[2]; } if (r == ONE) /* L /\ 1 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X /\ R is R ~==> X */ { exp[0] = NIMPLY; word = exp[1]; exp[1] = exp[2]; exp[2] = word + sizeof(WamWord); break; } if (r == NOT) /* L /\ ~X is L ~==> X */ { exp[0] = NIMPLY; exp[2] += sizeof(WamWord); break; } break; case NAND: if (l == ZERO || r == ZERO) /* 0 ~/\ R is 1 , L ~/\ 0 is 1 */ { sp = exp; *sp++ = ONE; break; } if (l == ONE) /* 1 ~/\ R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ONE) /* L ~/\ 1 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (l == NOT) /* ~X ~/\ R is R ==> X */ { exp[0] = IMPLY; word = exp[1]; exp[1] = exp[2]; exp[2] = word + sizeof(WamWord); break; } if (r == NOT) /* L ~/\ ~X is L ==> X */ { exp[0] = IMPLY; exp[2] += sizeof(WamWord); break; } break; case OR: if (l == ONE || r == ONE) /* 1 \/ R is 1 , L \/ 1 is 1 */ { sp = exp; *sp++ = ONE; break; } if (l == ZERO) /* 0 \/ R is R */ { return (WamWord *) exp[2]; } if (r == ZERO) /* L \/ 0 is L */ { sp = sp1; return (WamWord *) exp[1]; } if (l == NOT) /* ~X \/ R is X ==> R */ { exp[0] = IMPLY; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L \/ ~X is X ==> L */ { exp[0] = IMPLY; word = exp[1]; exp[1] = exp[2] + sizeof(WamWord); exp[2] = word; break; } break; case NOR: if (l == ONE || r == ONE) /* 1 ~\/ R is 0 , L ~\/ 1 is 0 */ { sp = exp; *sp++ = ZERO; break; } if (l == ZERO) /* 0 ~\/ R is ~R */ { sp = exp; return Simplify(-1, re_word); } if (r == ZERO) /* L ~\/ 0 is ~L */ { sp = exp; return Simplify(-1, le_word); } if (l == NOT) /* ~X ~\/ R is X ~==> R */ { exp[0] = NIMPLY; exp[1] += sizeof(WamWord); break; } if (r == NOT) /* L ~\/ ~X is X ~==> L */ { exp[0] = NIMPLY; word = exp[1]; exp[1] = exp[2] + sizeof(WamWord); exp[2] = word; break; } break; } return exp; } #ifdef DEBUG /*-------------------------------------------------------------------------* * DISPLAY_STACK * * * *-------------------------------------------------------------------------*/ static void Display_Stack(WamWord *exp) { int op = exp[0]; WamWord *le = (WamWord *) (exp[1]); WamWord *re = (WamWord *) (exp[2]); switch (op) { case NOT: DBGPRINTF("%s", pl_atom_tbl[Functor_Of(bool_tbl[op])].name); DBGPRINTF(" "); Pl_Write_1(exp[1]); break; case EQUIV: case NEQUIV: case IMPLY: case NIMPLY: case AND: case NAND: case OR: case NOR: DBGPRINTF("("); Display_Stack(le); DBGPRINTF(" "); DBGPRINTF("%s", pl_atom_tbl[Functor_Of(bool_tbl[op])].name); DBGPRINTF(" "); Display_Stack(re); DBGPRINTF(")"); break; case EQ: case NEQ: case LT: case LTE: case GT: case GTE: case EQ_F: case NEQ_F: case LT_F: case LTE_F: case GT_F: case GTE_F: Pl_Write_1(exp[1]); DBGPRINTF(" "); DBGPRINTF("%s", pl_atom_tbl[Functor_Of(bool_tbl[op])].name); DBGPRINTF(" "); Pl_Write_1(exp[2]); break; case ZERO: DBGPRINTF("0"); break; case ONE: DBGPRINTF("1"); break; default: Pl_Write_1(*exp); } } #endif /*-------------------------------------------------------------------------* * ADD_FD_VARIABLES * * * *-------------------------------------------------------------------------*/ static void Add_Fd_Variables(WamWord e_word) { WamWord word, tag_mask; WamWord *adr; int i; DEREF(e_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { if (vars_sp - vars_tbl == VARS_STACK_SIZE) Pl_Err_Resource(pl_resource_too_big_fd_constraint); *vars_sp++ = word; *vars_sp++ = 1; /* FD var */ return; } if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); Add_Fd_Variables(Car(adr)); Add_Fd_Variables(Cdr(adr)); } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); i = Arity(adr); do Add_Fd_Variables(Arg(adr, --i)); while (i); } } /*-------------------------------------------------------------------------* * LOAD_BOOL_INTO_WORD * * * * This loads a boolean term into a tagged word. * * Input: * * exp : boolean term to load * * result : which result is expected: * * 0=false, 1=true, * * 2=result into the word pointed by load_word. * * * * Output: * * load_word: if result=2 it will contain the tagged word of the term: * * a <INT,0/1> or a <REF,adr> * *-------------------------------------------------------------------------*/ static Bool Load_Bool_Into_Word(WamWord *exp, int result, WamWord *load_word) { PlULong op = *exp; if (op >= EQ_F && op <= LTE_F) { pl_full_ac = 1; op = op - EQ_F + EQ; } else pl_full_ac = 0; return (*((op <= ONE) ? func_tbl[op] : Set_Var)) (exp, result, load_word); } /*-------------------------------------------------------------------------* * SET_ZERO * * * *-------------------------------------------------------------------------*/ static Bool Set_Zero(WamWord *exp, int result, WamWord *load_word) { if (result == 0) /* 0 is false */ return TRUE; if (result == 1) /* 0 is true */ return FALSE; /* 0 = B */ return Pl_Get_Integer(0, *load_word); } /*-------------------------------------------------------------------------* * SET_ONE * * * *-------------------------------------------------------------------------*/ static Bool Set_One(WamWord *exp, int result, WamWord *load_word) { if (result == 0) /* 1 is false */ return FALSE; if (result == 1) /* 1 is true */ return TRUE; /* 1 = B */ return Pl_Get_Integer(1, *load_word); } /*-------------------------------------------------------------------------* * SET_VAR * * * *-------------------------------------------------------------------------*/ static Bool Set_Var(WamWord *exp, int result, WamWord *load_word) { if (result == 0) /* X is false */ return Pl_Get_Integer(0, *exp); if (result == 1) /* X is true */ return Pl_Get_Integer(1, *exp); *load_word = *exp; /* X = B */ return TRUE; } /*-------------------------------------------------------------------------* * SET_NOT * * * *-------------------------------------------------------------------------*/ static Bool Set_Not(WamWord *exp, int result, WamWord *load_word) { if (result == 0) /* ~X is false */ return Pl_Get_Integer(1, exp[1]); if (result == 1) /* ~X is true */ return Pl_Get_Integer(0, exp[1]); /* ~X=B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_2(pl_not_x_eq_b, exp[1], *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_EQUIV * * * *-------------------------------------------------------------------------*/ static Bool Set_Equiv(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; if (result == 0) /* L <=> R is false */ { BOOL_CSTR_2(pl_not_x_eq_b, load_l, load_r); return TRUE; } if (result == 1) /* L <=> R is true */ return Pl_Fd_Math_Unify_X_Y(load_l, load_r); /* L <=> R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_equiv_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_NEQUIV * * * *-------------------------------------------------------------------------*/ static Bool Set_Nequiv(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result <= 1) /* L ~<=> R is true or false */ return Set_Equiv(exp, 1 - result, load_word); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; /* L ~<=> R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_nequiv_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_IMPLY * * * *-------------------------------------------------------------------------*/ static Bool Set_Imply(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result == 0) /* L ==> R is false */ return Load_Bool_Into_Word((WamWord *) (exp[1]), 1, &load_l) && Load_Bool_Into_Word((WamWord *) (exp[2]), 0, &load_r); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; if (result == 1) /* L ==> R is true */ { BOOL_CSTR_2(pl_x_imply_y_eq_1, load_l, load_r); return TRUE; } /* L ==> R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_imply_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_NIMPLY * * * *-------------------------------------------------------------------------*/ static Bool Set_Nimply(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result <= 1) /* L ~==> R is true or false */ return Set_Imply(exp, 1 - result, load_word); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; /* L ~==> R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_nimply_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_AND * * * *-------------------------------------------------------------------------*/ static Bool Set_And(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result == 1) /* L /\ R is true */ return Load_Bool_Into_Word((WamWord *) (exp[1]), 1, NULL) && Load_Bool_Into_Word((WamWord *) (exp[2]), 1, NULL); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; if (result == 0) /* L /\ R is false */ { BOOL_CSTR_2(pl_x_and_y_eq_0, load_l, load_r); return TRUE; } /* L /\ R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_and_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_NAND * * * *-------------------------------------------------------------------------*/ static Bool Set_Nand(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result <= 1) /* L ~/\ R is true or false */ return Set_And(exp, 1 - result, load_word); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; /* L ~/\ R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_nand_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_OR * * * *-------------------------------------------------------------------------*/ static Bool Set_Or(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result == 0) /* L \/ R is false */ return Load_Bool_Into_Word((WamWord *) (exp[1]), 0, NULL) && Load_Bool_Into_Word((WamWord *) (exp[2]), 0, NULL); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; if (result == 1) /* L \/ R is true */ { BOOL_CSTR_2(pl_x_or_y_eq_1, load_l, load_r); return TRUE; } /* L \/ R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_or_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_NOR * * * *-------------------------------------------------------------------------*/ static Bool Set_Nor(WamWord *exp, int result, WamWord *load_word) { WamWord load_l, load_r; if (result <= 1) /* L ~\/ R is true or false */ return Set_Or(exp, 1 - result, load_word); if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) || !Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r)) return FALSE; /* L ~\/ R = B */ *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); BOOL_CSTR_3(pl_x_nor_y_eq_b, load_l, load_r, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_EQ * * * *-------------------------------------------------------------------------*/ static Bool Set_Eq(WamWord *exp, int result, WamWord *load_word) { WamWord le_word, re_word; int mask; WamWord l_word, r_word; PlLong c; le_word = exp[1]; re_word = exp[2]; if (result == 0) /* L = R is false */ return Pl_Fd_Neq_2(le_word, re_word); if (result == 1) /* L = R is true */ return Pl_Fd_Eq_2(le_word, re_word); *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); #ifdef DEBUG cur_op = (pl_full_ac) ? "truth#=#" : "truth#="; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word) || !Pl_Term_Math_Loading(l_word, r_word)) return FALSE; switch (mask) { case MASK_EMPTY: return Pl_Get_Integer(c == 0, *load_word); case MASK_LEFT: if (c > 0) return Pl_Get_Integer(0, *load_word); MATH_CSTR_3(pl_truth_x_eq_c, l_word, Tag_INT(-c), *load_word); return TRUE; case MASK_RIGHT: if (c < 0) return Pl_Get_Integer(0, *load_word); MATH_CSTR_3(pl_truth_x_eq_c, r_word, Tag_INT(c), *load_word); return TRUE; } if (c > 0) { MATH_CSTR_4(pl_truth_x_plus_c_eq_y, l_word, Tag_INT(c), r_word, *load_word); return TRUE; } if (c < 0) { MATH_CSTR_4(pl_truth_x_plus_c_eq_y, r_word, Tag_INT(-c), l_word, *load_word); return TRUE; } MATH_CSTR_3(pl_truth_x_eq_y, l_word, r_word, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_NEQ * * * *-------------------------------------------------------------------------*/ static Bool Set_Neq(WamWord *exp, int result, WamWord *load_word) { WamWord le_word, re_word; int mask; WamWord l_word, r_word; PlLong c; le_word = exp[1]; re_word = exp[2]; if (result == 0) /* L \= R is false */ return Pl_Fd_Eq_2(le_word, re_word); if (result == 1) /* L \= R is true */ return Pl_Fd_Neq_2(le_word, re_word); *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); #ifdef DEBUG cur_op = (pl_full_ac) ? "truth#\\=#" : "truth#\\="; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word) || !Pl_Term_Math_Loading(l_word, r_word)) return FALSE; switch (mask) { case MASK_EMPTY: return Pl_Get_Integer(c != 0, *load_word); case MASK_LEFT: if (c > 0) return Pl_Get_Integer(1, *load_word); MATH_CSTR_3(pl_truth_x_neq_c, l_word, Tag_INT(-c), *load_word); return TRUE; case MASK_RIGHT: if (c < 0) return Pl_Get_Integer(1, *load_word); MATH_CSTR_3(pl_truth_x_neq_c, r_word, Tag_INT(c), *load_word); return TRUE; } if (c > 0) { MATH_CSTR_4(pl_truth_x_plus_c_neq_y, l_word, Tag_INT(c), r_word, *load_word); return TRUE; } if (c < 0) { MATH_CSTR_4(pl_truth_x_plus_c_neq_y, r_word, Tag_INT(-c), l_word, *load_word); return TRUE; } MATH_CSTR_3(pl_truth_x_neq_y, l_word, r_word, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_LT * * * *-------------------------------------------------------------------------*/ static Bool Set_Lt(WamWord *exp, int result, WamWord *load_word) { WamWord le_word, re_word; int mask; WamWord l_word, r_word; PlLong c; le_word = exp[1]; re_word = exp[2]; if (result == 0) /* L < R is false */ return Pl_Fd_Lte_2(re_word, le_word); if (result == 1) /* L < R is true */ return Pl_Fd_Lt_2(le_word, re_word); *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); #ifdef DEBUG cur_op = (pl_full_ac) ? "truth#<#" : "truth#<"; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word) || !Pl_Term_Math_Loading(l_word, r_word)) return FALSE; switch (mask) { case MASK_EMPTY: return Pl_Get_Integer(c < 0, *load_word); case MASK_LEFT: if (c >= 0) return Pl_Get_Integer(0, *load_word); PRIM_CSTR_3(pl_truth_x_lte_c, l_word, Tag_INT(-c - 1), *load_word); return TRUE; case MASK_RIGHT: if (c < 0) return Pl_Get_Integer(1, *load_word); PRIM_CSTR_3(pl_truth_x_gte_c, r_word, Tag_INT(c + 1), *load_word); return TRUE; } if (c > 0) { PRIM_CSTR_4(pl_truth_x_plus_c_lte_y, l_word, Tag_INT(c + 1), r_word, *load_word); return TRUE; } if (c < 0) { PRIM_CSTR_4(pl_truth_x_plus_c_gte_y, r_word, Tag_INT(-c - 1), l_word, *load_word); return TRUE; } PRIM_CSTR_3(pl_truth_x_lt_y, l_word, r_word, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * SET_LTE * * * *-------------------------------------------------------------------------*/ static Bool Set_Lte(WamWord *exp, int result, WamWord *load_word) { WamWord le_word, re_word; int mask; WamWord l_word, r_word; PlLong c; le_word = exp[1]; re_word = exp[2]; if (result == 0) /* L <= R is false */ return Pl_Fd_Lt_2(re_word, le_word); if (result == 1) /* L <= R is true */ return Pl_Fd_Lte_2(le_word, re_word); *load_word = Tag_REF(Pl_Fd_New_Bool_Variable()); #ifdef DEBUG cur_op = (pl_full_ac) ? "truth#=<#" : "truth#=<"; #endif if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word) || !Pl_Term_Math_Loading(l_word, r_word)) return FALSE; switch (mask) { case MASK_EMPTY: return Pl_Get_Integer(c <= 0, *load_word); case MASK_LEFT: if (c > 0) return Pl_Get_Integer(0, *load_word); PRIM_CSTR_3(pl_truth_x_lte_c, l_word, Tag_INT(-c), *load_word); return TRUE; case MASK_RIGHT: if (c <= 0) return Pl_Get_Integer(1, *load_word); PRIM_CSTR_3(pl_truth_x_gte_c, r_word, Tag_INT(c), *load_word); return TRUE; } if (c > 0) { PRIM_CSTR_4(pl_truth_x_plus_c_lte_y, l_word, Tag_INT(c), r_word, *load_word); return TRUE; } if (c < 0) { PRIM_CSTR_4(pl_truth_x_plus_c_gte_y, r_word, Tag_INT(-c), l_word, *load_word); return TRUE; } PRIM_CSTR_3(pl_truth_x_lte_y, l_word, r_word, *load_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_FD_REIFIED_IN * * * *-------------------------------------------------------------------------*/ Bool Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word) { WamWord word, tag_mask; WamWord b_tag_mask, x_tag_mask; WamWord *adr, *fdv_adr; PlLong x; PlLong b = -1; /* a var */ int min, max; int x_min, x_max; Range *r; // Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word); /* from fd_values_c.c (optimized version) */ Bool Pl_Fd_Domain_Interval(WamWord x_word, int min, int max); /* from fd_values_fd.fd */ Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word); min = Pl_Fd_Prolog_To_Value(l_word); if (min < 0) min = 0; max = Pl_Fd_Prolog_To_Value(u_word); DEREF(x_word, word, tag_mask); x_word = word; x_tag_mask = tag_mask; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) { err_type_fd: Pl_Err_Type(pl_type_fd_variable, word); return FALSE; } DEREF(b_word, word, tag_mask); b_word = word; b_tag_mask = tag_mask; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK) goto err_type_fd; if (x_tag_mask == TAG_INT_MASK) { x = UnTag_INT(x_word); b = (x >= min) && (x <= max); unif_b: return Pl_Get_Integer(b, b_word); } if (b_tag_mask == TAG_INT_MASK) { b = UnTag_INT(b_word); if (b == 0) return pl_fd_not_domain(x_word, l_word, u_word); return (b == 1) && Pl_Fd_Domain_Interval(x_word, min, max); } if (x_tag_mask == TAG_REF_MASK) /* make an FD var */ { adr = UnTag_REF(x_word); fdv_adr = Pl_Fd_New_Variable(); Bind_UV(adr, Tag_REF(fdv_adr)); } else fdv_adr = UnTag_FDV(x_word); r = Range(fdv_adr); x_min = r->min; x_max = r->max; if (x_min >= min && x_max <= max) { b = 1; goto unif_b; } if (min > max || x_max < min || x_min > max) /* NB: if L..U is empty then B = 0 */ { b = 0; goto unif_b; } if (!Pl_Fd_Check_For_Bool_Var(b_word)) return FALSE; PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word); return TRUE; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_math_fd.fd��������������������������������������������������������������0000644�0001750�0001750�00000057557�13021324543�015626� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_math_fd.fd * * Descr.: mathematical predicate management - FD part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ %{ #include "bips_fd.h" #define ite(i, t, e) ((i) ? (t) : (e)) %} /*-------------------------------------------------------------------------* * EQUAL (LINEAR) * * * * NB: pl_x_eq_c(fdv X, int C) is defined as a function in math_supp.c to * * avoid A Frame creation. * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_x_eq_y(fdv X, fdv Y) { start X in min(Y) .. max(Y) start Y in min(X) .. max(X) } pl_x_plus_c_eq_y(fdv X, int C, fdv Y) { start X in min(Y) - C .. max(Y) - C start Y in min(X) + C .. max(X) + C } /*------------* * Full AC * *------------*/ pl_x_eq_y_F(fdv X, fdv Y) { start X in dom(Y) start Y in dom(X) } pl_x_plus_c_eq_y_F(fdv X, int C, fdv Y) { start X in dom(Y) - C start Y in dom(X) + C } /*-------------------------------------------------------------------------* * DIFFERENT (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_x_neq_c(fdv X, int C) { start X in ~{C} } pl_x_neq_y(fdv X, fdv Y) { start X in ~{val(Y)} start Y in ~{val(X)} } pl_x_plus_c_neq_y(fdv X, int C, fdv Y) { start X in ~{val(Y) - C} start Y in ~{val(X) + C} } /*-------------------------------------------------------------------------* * LESS THAN (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_x_lt_y(fdv X, fdv Y) { start X in 0 .. max(Y) - 1 start Y in min(X) + 1 .. max_integer } /*-------------------------------------------------------------------------* * LESS THAN OR EQUAL TO (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_x_lte_c(fdv X, int C) { start X in 0 .. C } pl_x_lte_y(fdv X, fdv Y) { start X in 0 .. max(Y) start Y in min(X) .. max_integer } pl_x_plus_c_lte_y(fdv X, int C, fdv Y) { start X in 0 .. max(Y) - C start Y in min(X) + C .. max_integer } /*-------------------------------------------------------------------------* * GREATER THAN OR EQUAL TO (LINEAR) * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_x_gte_c(fdv X, int C) { start X in C .. max_integer } pl_x_plus_c_gte_y(fdv X, int C, fdv Y) { start X in min(Y) - C .. max_integer start Y in 0 .. max(X) + C } /*-------------------------------------------------------------------------* * OTHER EQUAL (LINEAR) * * * * NB: used to split large equations introducing intermediate variables. * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_ax_eq_y(int A, fdv X, fdv Y) { start X in (min(Y)) /> A .. (max(Y)) /< A start Y in A*min(X) .. A*max(X) } pl_x_plus_y_eq_z(fdv X, fdv Y, fdv Z) { start X in min(Z) - max(Y) .. max(Z) - min(Y) start Y in min(Z) - max(X) .. max(Z) - min(X) start Z in min(X) + min(Y) .. max(X) + max(Y) } pl_ax_plus_y_eq_z(int A, fdv X, fdv Y, fdv Z) { start X in (min(Z) - max(Y)) /> A .. (max(Z) - min(Y)) /< A start Y in min(Z) - A*max(X) .. max(Z) - A*min(X) start Z in A*min(X) + min(Y) .. A*max(X) + max(Y) } pl_ax_plus_by_eq_z(int A, fdv X, int B, fdv Y, fdv Z) { start X in (min(Z) - B*max(Y)) /> A .. (max(Z) - B*min(Y)) /< A start Y in (min(Z) - A*max(X)) /> B .. (max(Z) - A*min(X)) /< B start Z in A*min(X) + B*min(Y) .. A*max(X) + B*max(Y) } pl_x_plus_y_plus_z_eq_t(fdv X, fdv Y, fdv Z, fdv T) { start X in min(T) - max(Y) - max(Z) .. max(T) - min(Y) - min(Z) start Y in min(T) - max(X) - max(Z) .. max(T) - min(X) - min(Z) start Z in min(T) - max(X) - max(Y) .. max(T) - min(X) - min(Y) start T in min(X) + min(Y) + min(Z) .. max(X) + max(Y) + max(Z) } pl_ax_plus_y_plus_z_eq_t(int A, fdv X, fdv Y, fdv Z, fdv T) { start X in (min(T) - max(Y) - max(Z)) /> A .. (max(T) - min(Y) - min(Z)) /< A start Y in min(T) - A*max(X) - max(Z) .. max(T) - A*min(X) - min(Z) start Z in min(T) - A*max(X) - max(Y) .. max(T) - A*min(X) - min(Y) start T in A*min(X) + min(Y) + min(Z) .. A*max(X) + max(Y) + max(Z) } pl_ax_plus_by_plus_z_eq_t(int A, fdv X, int B, fdv Y, fdv Z, fdv T) { start X in (min(T) - B*max(Y) - max(Z)) /> A .. (max(T) - B*min(Y) - min(Z)) /< A start Y in (min(T) - A*max(X) - max(Z)) /> B .. (max(T) - A*min(X) - min(Z)) /< B start Z in min(T) - A*max(X) - B*max(Y) .. max(T) - A*min(X) - B*min(Y) start T in A*min(X) + B*min(Y) + min(Z) .. A*max(X) + B*max(Y) + max(Z) } /*------------* * Full AC * *------------*/ pl_ax_eq_y_F(int A, fdv X, fdv Y) { start X in (dom(Y)) / A start Y in dom(X)*A } pl_x_plus_y_eq_z_F(fdv X, fdv Y, fdv Z) { start X in dom(Z) -- dom(Y) start Y in dom(Z) -- dom(X) start Z in dom(X) ++ dom(Y) } pl_ax_plus_y_eq_z_F(int A, fdv X, fdv Y, fdv Z) { start X in (dom(Z) -- dom(Y)) / A start Y in dom(Z) -- dom(X)*A start Z in dom(X)*A ++ dom(Y) } pl_ax_plus_by_eq_z_F(int A, fdv X, int B, fdv Y, fdv Z) { start X in (dom(Z) -- dom(Y)*B) / A start Y in (dom(Z) -- dom(X)*A) / B start Z in dom(X)*A ++ dom(Y)*B } pl_x_plus_y_plus_z_eq_t_F(fdv X, fdv Y, fdv Z, fdv T) { start X in dom(T) -- dom(Y) -- dom(Z) start Y in dom(T) -- dom(X) -- dom(Z) start Z in dom(T) -- dom(X) -- dom(Y) start T in dom(X) ++ dom(Y) ++ dom(Z) } pl_ax_plus_y_plus_z_eq_t_F(int A, fdv X, fdv Y, fdv Z, fdv T) { start X in (dom(T) -- dom(Y) -- dom(Z)) / A start Y in dom(T) -- dom(X)*A -- dom(Z) start Z in dom(T) -- dom(X)*A -- dom(Y) start T in dom(X)*A ++ dom(Y) ++ dom(Z) } pl_ax_plus_by_plus_z_eq_t_F(int A, fdv X, int B, fdv Y, fdv Z, fdv T) { start X in (dom(T) -- dom(Y)*B -- dom(Z)) / A start Y in (dom(T) -- dom(X)*A -- dom(Z)) / B start Z in dom(T) -- dom(X)*A -- dom(Y)*B start T in dom(X)*A ++ dom(Y)*B ++ dom(Z) } /*-------------------------------------------------------------------------* * POWER and X * Y * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_zero_power_n_eq_y(fdv N, fdv Y) { start Y in ite(max(N)==0, 1, 0)..ite(min(N)==0, 1, 0) start N in ite(max(Y)==0, 1, 0)..ite(min(Y)==0, max_integer, 0) } pl_a_power_n_eq_y(int A, fdv N, fdv Y) /* here A >= 2 */ { start Y in Pl_Power(A, min(N))..Pl_Power(A, max(N)) /* before to ensure Y >= 1 */ start N in Pl_Find_Expon_Up(A, min(Y))..Pl_Find_Expon_Dn(A, max(Y)) } pl_x_power_a_eq_y(fdv X, int A, fdv Y) /* here A > 2 */ { start Y in Pl_Power(min(X), A)..Pl_Power(max(X), A) start X in Pl_Nth_Root_Up(min(Y), A)..Pl_Nth_Root_Dn(max(Y), A) } pl_x2_eq_y(fdv X, fdv Y) { start X in Pl_Sqrt_Up(min(Y))..Pl_Sqrt_Dn(max(Y)) start Y in min(X)*min(X)..max(X)*max(X) } pl_xy_eq_z(fdv X, fdv Y, fdv Z) { start X in ite(max(Y)==0, 0, min(Z) /> max(Y)) .. ite(min(Y)==0, max_integer, max(Z) /< min(Y)) start Y in ite(max(X)==0, 0, min(Z) /> max(X)) .. ite(min(X)==0, max_integer, max(Z) /< min(X)) start Z in min(X)*min(Y)..max(X)*max(Y) } /*------------* * Full AC * *------------*/ pl_a_power_n_eq_y_F(int A, fdv N, fdv Y) /* here A >= 2 */ { start Y in Pl_Full_Coeff_Power_Var(A, dom(N)) /* to ensure Y < pl_vec_max_integer */ start N in Pl_Full_Find_Expon(A, dom(Y)) } pl_x_power_a_eq_y_F(fdv X, int A, fdv Y) /* here A > 2 */ { start Y in Pl_Full_Var_Power_Coeff(dom(X), A) /* to ensure Y < pl_vec_max_integer */ start X in Pl_Full_Nth_Root(dom(Y), A) } pl_x2_eq_y_F(fdv X, fdv Y) { start Y in Pl_Full_Var_Power_2(dom(X)) /* to ensure Y < pl_vec_max_integer */ start X in Pl_Full_Sqrt_Var(dom(Y)) } pl_xy_eq_z_F(fdv X, fdv Y, fdv Z) { start Z in dom(X)**dom(Y) wait_switch case min(Z) > 0 start Y in 1..max_integer start X in dom(Z)//dom(Y) start Y in dom(Z)//dom(X) case max(Z)==0 && min(Y) > 0 start X in { 0 } case max(Z)==0 && min(X) > 0 start Y in { 0 } } /*-------------------------------------------------------------------------* * MINIMUM * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_min_x_y_eq_z(fdv X, fdv Y, fdv Z) { start (c1) Z in math_min(min(X), min(Y)) .. max_integer /* Z >= min(X, Y) */ start (c2) Z in 0 .. max(X) /* Z <= X */ start (c3) X in min(Z) .. max_integer start (c4) Z in 0 .. max(Y) /* Z <= Y */ start (c5) Y in min(Z) .. max_integer wait_switch case min(Y) > max(Z) /* case : Y != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in min(X) .. max(X) /* Z = X */ start X in min(Z) .. max(Z) case min(X) > max(Z) /* case : X != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in min(Y) .. max(Y) /* Z = Y */ start Y in min(Z) .. max(Z) } pl_min_x_a_eq_z(fdv X, int A, fdv Z) { start (c1) Z in math_min(min(X), A) .. max_integer /* Z >= min(X, A) */ start (c2) Z in 0 .. max(X) /* Z <= X */ start (c3) X in min(Z) .. max_integer start Z in 0 .. A /* Z <= A */ wait_switch case A > max(Z) /* case : A != Z */ stop c1 stop c2 stop c3 start Z in min(X) .. max(X) /* Z = X */ start X in min(Z) .. max(Z) } /*------------* * Full AC * *------------*/ pl_min_x_y_eq_z_F(fdv X, fdv Y, fdv Z) { start (c1) Z in dom(X) : dom(Y) /* Z = X or Z = Y */ start (c2) Z in 0 .. max(X) /* Z <= X */ start (c3) X in min(Z) .. max_integer start (c4) Z in 0 .. max(Y) /* Z <= Y */ start (c5) Y in min(Z) .. max_integer wait_switch case Pl_Range_Test_Null_Inter(dom(Y), dom(Z)) /* case : Y != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in dom(X) /* Z = X */ start X in dom(Z) case Pl_Range_Test_Null_Inter(dom(X), dom(Z)) /* case : X != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in dom(Y) /* Z = Y */ start Y in dom(Z) } pl_min_x_a_eq_z_F(fdv X, int A, fdv Z) { start (c1) Z in dom(X) : {A} /* Z = X or Z = A */ start (c2) Z in 0 .. max(X) /* Z <= X */ start (c3) X in min(Z) .. max_integer start Z in 0 .. A /* Z <= A */ wait_switch case A > max(Z) /* case : A != Z */ stop c1 stop c2 stop c3 start Z in dom(X) /* Z = X */ start X in dom(Z) } /*-------------------------------------------------------------------------* * MAXIMUM * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_max_x_y_eq_z(fdv X, fdv Y, fdv Z) { start (c1) Z in 0 .. math_max(max(X), max(Y)) /* Z <= max(X, Y) */ start (c2) Z in min(X) .. max_integer /* Z >= X */ start (c3) X in 0 .. max(Z) start (c4) Z in min(Y) .. max_integer /* Z >= Y */ start (c5) Y in 0 .. max(Z) wait_switch case max(Y) < min(Z) /* case : Y != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in min(X) .. max(X) /* Z = X */ start X in min(Z) .. max(Z) case max(X) < min(Z) /* case : X != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in min(Y) .. max(Y) /* Z = Y */ start Y in min(Z) .. max(Z) } pl_max_x_a_eq_z(fdv X, int A, fdv Z) { start (c1) Z in 0 .. math_max(max(X), A) /* Z <= max(X, A) */ start (c2) Z in min(X) .. max_integer /* Z >= X */ start (c3) X in 0 .. max(Z) start Z in A .. max_integer /* Z >= A */ wait_switch case A < min(Z) /* case : A != Z */ stop c1 stop c2 stop c3 start Z in min(X) .. max(X) /* Z = X */ start X in min(Z) .. max(Z) } /*------------* * Full AC * *------------*/ pl_max_x_y_eq_z_F(fdv X, fdv Y, fdv Z) { start (c1) Z in dom(X) : dom(Y) /* Z = X or Z = Y */ start (c2) Z in min(X) .. max_integer /* Z >= X */ start (c3) X in 0 .. max(Z) start (c4) Z in min(Y) .. max_integer /* Z >= Y */ start (c5) Y in 0 .. max(Z) wait_switch case Pl_Range_Test_Null_Inter(dom(Y), dom(Z)) /* case : Y != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in dom(X) /* Z = X */ start X in dom(Z) case Pl_Range_Test_Null_Inter(dom(X), dom(Z)) /* case : X != Z */ stop c1 stop c2 stop c3 stop c4 stop c5 start Z in dom(Y) /* Z = Y */ start Y in dom(Z) } pl_max_x_a_eq_z_F(fdv X, int A, fdv Z) { start (c1) Z in dom(X) : {A} /* Z = X or Z = A */ start (c2) Z in min(X) .. max_integer /* Z >= X */ start (c3) X in 0 .. max(Z) start Z in A .. max_integer /* Z >= A */ wait_switch case A < min(Z) /* case : A != Z */ stop c1 stop c2 stop c3 start Z in dom(X) /* Z = X */ start X in dom(Z) } /*-------------------------------------------------------------------------* * ABSOLUTE VALUE * * * *-------------------------------------------------------------------------*/ /*------------* * Partial AC * *------------*/ pl_abs_x_minus_y_eq_z(fdv X, fdv Y, fdv Z) { start (c1) X in min(Y) + min(Z) .. max(Y) + max(Z) : min(Y) - max(Z) .. max(Y) - min(Z) start (c2) Y in min(X) + min(Z) .. max(X) + max(Z) : min(X) - max(Z) .. max(X) - min(Z) start (c3) Z in min(X) - max(Y) .. max(X) - min(Y) : min(Y) - max(X) .. max(Y) - min(X) wait_switch case min(X) >= max(Y) /* case : X >= Y */ stop c1 stop c2 stop c3 start X in min(Y) + min(Z) .. max(Y) + max(Z) start Y in min(X) - max(Z) .. max(X) - min(Z) start Z in min(X) - max(Y) .. max(X) - min(Y) case min(Y) >= max(X) /* case : Y >= X */ stop c1 stop c2 stop c3 start X in min(Y) - max(Z) .. max(Y) - min(Z) start Y in min(X) + min(Z) .. max(X) + max(Z) start Z in min(Y) - max(X) .. max(Y) - min(X) } /*------------* * Full AC * *------------*/ pl_abs_x_minus_a_eq_z(fdv X, int A, fdv Z) { start (c1) X in A + min(Z) .. A + max(Z) : A - max(Z) .. A - min(Z) start (c2) Z in min(X) - A .. max(X) - A : A - max(X) .. A - min(X) wait_switch case min(X) >= A /* case : X >= A */ stop c1 stop c2 start X in A + min(Z) .. A + max(Z) start Z in min(X) - A .. max(X) - A case A >= max(X) /* case : A >= X */ stop c1 stop c2 start X in A - max(Z) .. A - min(Z) start Z in A - max(X) .. A - min(X) } pl_abs_x_minus_y_eq_z_F(fdv X, fdv Y, fdv Z) { start (c1) X in dom(Y) ++ dom(Z) : dom(Y) -- dom(Z) start (c2) Y in dom(X) ++ dom(Z) : dom(X) -- dom(Z) start (c3) Z in dom(X) -- dom(Y) : dom(Y) -- dom(X) wait_switch case min(X) >= max(Y) /* case : X >= Y */ stop c1 stop c2 stop c3 start X in dom(Y) ++ dom(Z) start Y in dom(X) -- dom(Z) start Z in dom(X) -- dom(Y) case min(Y) >= max(X) /* case : Y >= X */ stop c1 stop c2 stop c3 start X in dom(Y) -- dom(Z) start Y in dom(X) ++ dom(Z) start Z in dom(Y) -- dom(X) } pl_abs_x_minus_a_eq_z_F(fdv X, int A, fdv Z) { start (c1) X in dom(Z) + A : { A } -- dom(Z) start (c2) Z in dom(X) - A : { A } -- dom(X) wait_switch case min(X) >= A /* case : X >= A */ stop c1 stop c2 start X in dom(Z) + A start Z in dom(X) - A case A >= max(X) /* case : A >= X */ stop c1 stop c2 start X in { A } -- dom(Z) start Z in { A } -- dom(X) } /*-------------------------------------------------------------------------* * EUCLIDIAN DIVISION WITH REMAINDER * * * *-------------------------------------------------------------------------*/ /* Compute X // Y = Z with remainder R, i.e X = Z*Y + R */ /*------------* * Partial AC * *------------*/ pl_quot_rem_x_y_r_eq_z(fdv X, fdv Y, fdv R, fdv Z) /* X = Z*Y+R */ { start Y in min(R)+1 .. max_integer /* R < Y */ start R in 0 .. max(Y)-1 start Z in (min(X)-max(R)) /> max(Y) .. (max(X)-min(R)) /< min(Y) start R in min(X)-(max(Z)*max(Y)) .. max(X)-(min(Z)*min(Y)) start X in min(Z)*min(Y)+min(R) .. max(Z)*max(Y)+max(R) start Y in (min(X) /< (max(Z)+1))+1..max_integer /* Y > X/(Z+1) */ start X in 0..(max(Z)+1)*max(Y)-1 wait_switch case min(Z) > 0 start Y in (min(X)-max(R)) /> max(Z).. (max(X)-min(R)) /< min(Z) } pl_quot_rem_a_y_r_eq_z(int A, fdv Y, fdv R, fdv Z) /* A = Z*Y+R */ { start Y in min(R)+1 .. max_integer /* R < Y */ start R in 0 .. max(Y)-1 start Y in (A /< (max(Z)+1))+1..max_integer /* Y > A/(Z+1) */ start Z in (A-max(R)) /> max(Y) .. (A-min(R)) /< min(Y) start R in A-(max(Z)*max(Y)) .. A-(min(Z)*min(Y)) wait_switch case min(Z) > 0 start Y in (A-max(R)) /> max(Z)..(A-min(R)) /< min(Z) } pl_quot_rem_x_a_r_eq_z(fdv X, int A, fdv R, fdv Z) /* X = Z*A+R */ { start R in 0 .. A-1 /* R < A */ start Z in (min(X)-max(R)) /> A .. (max(X)-min(R)) /< A start R in min(X)-(max(Z)*A) .. max(X)-(min(Z)*A) start X in min(Z)*A+min(R) .. max(Z)*A+max(R) start X in 0..(max(Z)+1)*A-1 /* X < (Z+1)*A */ } /*------------* * Full AC * *------------*/ pl_quot_rem_x_y_r_eq_z_F(fdv X, fdv Y, fdv R, fdv Z) /* X = Z*Y+R */ { start Y in min(R)+1 .. max_integer /* R < Y */ start R in 0 .. max(Y)-1 start Z in (dom(X)--dom(R))//dom(Y) start R in dom(X)--(dom(Z)**dom(Y)) start X in dom(Z)**dom(Y)++dom(R) start Y in (min(X) /< (max(Z)+1))+1..max_integer /* Y > X/(Z+1) */ start X in 0..(max(Z)+1)*max(Y)-1 wait_switch case min(Z) > 0 start Y in (dom(X)--dom(R)) // dom(Z) } pl_quot_rem_a_y_r_eq_z_F(int A, fdv Y, fdv R, fdv Z) /* A = Z*Y+R */ { start Y in min(R)+1 .. max_integer /* R < Y */ start R in 0 .. max(Y)-1 start Y in (A /< (max(Z)+1))+1..max_integer /* Y > A/(Z+1) */ start Z in ({ A }--dom(R))//dom(Y) start R in { A }--(dom(Z)**dom(Y)) wait_switch case min(Z) > 0 start Y in ({ A }--dom(R)) // dom(Z) } pl_quot_rem_x_a_r_eq_z_F(fdv X, int A, fdv R, fdv Z) /* X = Z*A+R */ { start R in 0 .. A-1 /* R < A */ start Z in (dom(X)--dom(R))/A start R in dom(X)--(dom(Z)*A) start X in (dom(Z)*A)++dom(R) start X in 0..(max(Z)+1)*A-1 /* X < (Z+1)*A */ } �������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_prime_c.c���������������������������������������������������������������0000644�0001750�0001750�00000013054�13021324543�015453� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_prime_c.c * * Descr.: prime constraint management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include "engine_pl.h" #include "bips_pl.h" #include "engine_fd.h" #include "bips_fd.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int prime_vec_size; static Range prime_range; static Range not_prime_range; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Compute_Prime_Range(void); /*-------------------------------------------------------------------------* * PL_PRIME_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Prime_Range(Range *r) { if (prime_vec_size != pl_vec_size) Compute_Prime_Range(); Pl_Range_Copy(r, &prime_range); } /*-------------------------------------------------------------------------* * PL_NOT_PRIME_RANGE * * * *-------------------------------------------------------------------------*/ void Pl_Not_Prime_Range(Range *r) { if (prime_vec_size != pl_vec_size) Compute_Prime_Range(); Pl_Range_Copy(r, ¬_prime_range); } /*-------------------------------------------------------------------------* * COMPUTE_PRIME_RANGE * * * *-------------------------------------------------------------------------*/ static void Compute_Prime_Range(void) { int i, j; Vector vec, nvec, end; if (prime_range.vec) { Free(prime_range.vec); Free(not_prime_range.vec); } prime_range.vec = vec = (Vector) Malloc(pl_vec_size * sizeof(VecWord)); not_prime_range.vec = nvec = (Vector) Malloc(pl_vec_size * sizeof(VecWord)); Pl_Vector_Full(vec); Vector_Reset_Value(vec, 0); Vector_Reset_Value(vec, 1); i = 2; do { j = i; while ((j += i) <= pl_vec_max_integer) Vector_Reset_Value(vec, j); j = i; i = Pl_Vector_Next_After(vec, i); } while (i > 0); prime_range.extra_cstr = TRUE; prime_range.min = 2; prime_range.max = j; not_prime_range.extra_cstr = TRUE; not_prime_range.min = 0; not_prime_range.max = (j < pl_vec_max_integer) ? pl_vec_max_integer : pl_vec_max_integer - 1; end = vec + pl_vec_size; do { *nvec = ~(*vec); vec++; nvec++; } while (vec < end); prime_vec_size = pl_vec_size; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_math.pl�����������������������������������������������������������������0000644�0001750�0001750�00000010220�13021324543�015147� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_math.pl * * Descr.: mathematical predicate management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_math'. LE #= RE :- set_bip_name(#=, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(0)), '$call_c_test'('Pl_Fd_Eq_2'(LE, RE)). LE #\= RE :- set_bip_name(#\=, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(0)), '$call_c_test'('Pl_Fd_Neq_2'(LE, RE)). LE #< RE :- set_bip_name(#<, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(0)), '$call_c_test'('Pl_Fd_Lt_2'(LE, RE)). LE #=< RE :- set_bip_name(#=<, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(0)), '$call_c_test'('Pl_Fd_Lte_2'(LE, RE)). LE #> RE :- set_bip_name(#>, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(0)), '$call_c_test'('Pl_Fd_Lt_2'(RE, LE)). LE #>= RE :- set_bip_name(#>=, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(0)), '$call_c_test'('Pl_Fd_Lte_2'(RE, LE)). LE #=# RE :- set_bip_name(#=, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(1)), '$call_c_test'('Pl_Fd_Eq_2'(LE, RE)). LE #\=# RE :- set_bip_name(#\=, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(1)), '$call_c_test'('Pl_Fd_Neq_2'(LE, RE)). LE #<# RE :- set_bip_name(#<, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(1)), '$call_c_test'('Pl_Fd_Lt_2'(LE, RE)). LE #=<# RE :- set_bip_name(#=<, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(1)), '$call_c_test'('Pl_Fd_Lte_2'(LE, RE)). LE #># RE :- set_bip_name(#>, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(1)), '$call_c_test'('Pl_Fd_Lt_2'(RE, LE)). LE #>=# RE :- set_bip_name(#>=, 2), '$call_c'('Pl_Fd_Set_Full_Ac_Flag_1'(1)), '$call_c_test'('Pl_Fd_Lte_2'(RE, LE)). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/all_fd_bips.pl�������������������������������������������������������������0000644�0001750�0001750�00000005555�13021324543�016022� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : all_fd_bips.pl * * Descr.: all bips (to force the linker) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ '$use_all_fd_bips' :- '$use_fd_infos', '$use_fd_values', '$use_fd_math', '$use_fd_bool', '$use_fd_prime', '$use_fd_symbolic', '$use_fd_optim'. ���������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_prime.pl����������������������������������������������������������������0000644�0001750�0001750�00000005623�13021324543�015345� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_prime.pl * * Descr.: prime constraint management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_prime'. fd_prime(X) :- set_bip_name(fd_prime, 1), fd_tell(pl_prime_x(X)). fd_not_prime(X) :- set_bip_name(fd_not_prime, 1), fd_tell(pl_not_prime_x(X)). �������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/fd_optim.pl����������������������������������������������������������������0000644�0001750�0001750�00000007156�13021324543�015364� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : FD constraint solver buit-in predicates * * File : fd_optim.pl * * Descr.: optimization predicate management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in_fd. '$use_fd_optim'. :- meta_predicate(fd_minimize(0, ?)). :- meta_predicate(fd_maximize(0, ?)). fd_minimize(Goal, Var) :- fd_max_integer(Inf), g_assign('$cur_min', Inf), repeat, g_read('$cur_min', B), B1 is B - 1, set_bip_name(fd_minimize, 2), ( '$fd_domain'(Var, 0, B1), '$call'(Goal, user, fd_minimize, 2) -> % FIXME: CallerModule fd_min(Var, C), g_assign('$cur_min', C), fail ; !, Var = B, '$call'(Goal, user, fd_minimize, 2) % FIXME: CallerModule ). fd_maximize(Goal, Var) :- fd_max_integer(Inf), g_assign('$cur_max', 0), repeat, g_read('$cur_max', B), B1 is B + 1, set_bip_name(fd_maximize, 2), ( '$fd_domain'(Var, B1, Inf), '$call'(Goal, user, fd_maximize, 2) -> % FIXME: CallerModule fd_max(Var, C), g_assign('$cur_max', C), fail ; !, Var = B, '$call'(Goal, user, fd_maximize, 2) % FIXME: CallerModule ). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsFD/Makefile.in����������������������������������������������������������������0000644�0001750�0001750�00000003255�13021324543�015267� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������LIB_BIPS_FD = @LIB_BIPS_FD@ LIB_ENGINE_FD = @LIB_ENGINE_FD@ GPLC = @GPLC@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ AR_RC = @AR_RC@ RANLIB = @RANLIB@ LIBNAME = $(LIB_BIPS_FD) OBJLIB = fd_infos@OBJ_SUFFIX@ fd_infos_c@OBJ_SUFFIX@ \ fd_values@OBJ_SUFFIX@ fd_values_c@OBJ_SUFFIX@ fd_values_fd@OBJ_SUFFIX@ \ fd_math@OBJ_SUFFIX@ fd_math_c@OBJ_SUFFIX@ fd_math_fd@OBJ_SUFFIX@ \ fd_bool@OBJ_SUFFIX@ fd_bool_c@OBJ_SUFFIX@ fd_bool_fd@OBJ_SUFFIX@ \ fd_prime@OBJ_SUFFIX@ fd_prime_c@OBJ_SUFFIX@ fd_prime_fd@OBJ_SUFFIX@ \ fd_symbolic@OBJ_SUFFIX@ fd_symbolic_c@OBJ_SUFFIX@ fd_symbolic_fd@OBJ_SUFFIX@ \ fd_optim@OBJ_SUFFIX@ \ math_supp@OBJ_SUFFIX@ \ oper_supp@OBJ_SUFFIX@ \ all_fd_bips@OBJ_SUFFIX@ .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .c .fd .pl $(SUFFIXES) .pl@OBJ_SUFFIX@: $(GPLC) -c $(GPLCFLAGS) --no-redef-error $*.pl .fd@OBJ_SUFFIX@: $(GPLC) -c -C '$(CFLAGS) $(CLFAGS_UNSIGNED_CHAR)' $*.fd .c@OBJ_SUFFIX@: $(GPLC) -c -C '$(CFLAGS) $(CLFAGS_UNSIGNED_CHAR)' $*.c $(LIBNAME): $(OBJLIB) rm -f $(LIBNAME) $(AR_RC)@AR_SEP@$(LIBNAME) $(OBJLIB) $(RANLIB) $(LIBNAME) clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp $(LIBNAME) distclean: clean # for test t_fd.c: t_fd.fd ../Fd2C/fd2c $(GPLC) --fd-to-c t_fd.fd t@EXE_SUFFIX@: t@OBJ_SUFFIX@ t_fd@OBJ_SUFFIX@ t_c@OBJ_SUFFIX@ ../EngineFD/$(LIB_ENGINE_FD) \ ../EngineFD/fd_to_c.h $(LIBNAME) $(GPLC) -o t@EXE_SUFFIX@ t@OBJ_SUFFIX@ t_fd@OBJ_SUFFIX@ t_c@OBJ_SUFFIX@ # depending on math_supp.h math_supp@OBJ_SUFFIX@: math_supp.h fd_math_c@OBJ_SUFFIX@: math_supp.h fd_bool_c@OBJ_SUFFIX@: math_supp.h ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/��������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013473� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/hexfilter.c���������������������������������������������������������������0000644�0001750�0001750�00000023665�13021324543�015641� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Utiliy * * File : hexfilter.c * * Descr.: Prolog hexadecimal decoding filter * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <ctype.h> #include <stdarg.h> #include "../EnginePl/gp_config.h" #include "decode_hexa.c" /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_ARGS 1024 #define HEXGPLC_VERSION "1.1" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ int encode = 0; int strict = 1; int quote = 1; int enclose = 1; int decode_aux = 0; int cmd_line = 0; char *format = NULL; FILE *fin = NULL; char *arg[MAX_ARGS]; int nb_arg = 0; /*---------------------------------* * Function Prototypes * *---------------------------------*/ void One_File(FILE *f); void One_Line(char *str); void Pl_Fatal_Error(char *format, ...); void Parse_Arguments(int argc, char *argv[]); void Display_Help(void); #define Check_Arg(i, str) (strncmp(argv[i], str, strlen(argv[i])) == 0) /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { FILE *f; int i; Parse_Arguments(argc, argv); if (nb_arg == 0) { if (cmd_line) Pl_Fatal_Error("command-line is empty"); One_File(stdin); return 0; } for (i = 0; i < nb_arg; i++) { if (cmd_line) { One_Line(arg[i]); putchar('\n'); continue; } if ((f = fopen(arg[i], "rt")) == NULL) Pl_Fatal_Error("cannot open %s", arg[i]); One_File(f); fclose(f); } return 0; } /*-------------------------------------------------------------------------* * ONE_FILE * * * *-------------------------------------------------------------------------*/ void One_File(FILE *f) { static char buff[4096]; for (;;) { if (fgets(buff, sizeof(buff), f) == NULL) break; One_Line(buff); } } /*-------------------------------------------------------------------------* * ONE_LINE * * * *-------------------------------------------------------------------------*/ void One_Line(char *str) { if (encode) fputs(Encode_Hexa_Line(str, format, strict), stdout); else fputs(Decode_Hexa_Line(str, format, strict, quote, decode_aux), stdout); } /*-------------------------------------------------------------------------* * PARSE_ARGUMENTS * * * *-------------------------------------------------------------------------*/ void Parse_Arguments(int argc, char *argv[]) { int i; for (i = 1; i < argc; i++) { if (*argv[i] == '-' && argv[i][1] != '\0') { if (Check_Arg(i, "--encode") || Check_Arg(i, "--mangling")) { encode = 1; continue; } if (Check_Arg(i, "--decode") || Check_Arg(i, "--demangling")) { encode = 0; continue; } if (Check_Arg(i, "--relax")) { strict = 0; continue; } if (Check_Arg(i, "--strict")) { strict = 1; continue; } if (Check_Arg(i, "--quote")) { quote = 1; continue; } if (Check_Arg(i, "--no-quote")) { quote = 0; continue; } if (Check_Arg(i, "--printf")) { if (++i >= argc) Pl_Fatal_Error("format missing after -printf option"); format = argv[i]; continue; } if (Check_Arg(i, "--aux-father")) { decode_aux = 1; continue; } if (Check_Arg(i, "--aux-father2")) { decode_aux = 2; continue; } if (Check_Arg(i, "--cmd-line")) { cmd_line = 1; continue; } if (Check_Arg(i, "-E") || Check_Arg(i, "-M")) { encode = 1; cmd_line = 1; strict = 0; continue; } if (Check_Arg(i, "-P") || Check_Arg(i, "-D")) { encode = 0; cmd_line = 1; strict = 0; decode_aux = 0; continue; } if (Check_Arg(i, "--version")) { fprintf(stderr, "Prolog/Hexa Filter "); fprintf(stderr, " Daniel Diaz - 1998\n"); fprintf(stderr, "%s version %s\n", HEXGPLC, HEXGPLC_VERSION); exit(0); } if (Check_Arg(i, "-h") || Check_Arg(i, "--help")) { Display_Help(); exit(0); } Pl_Fatal_Error("unknown option %s - try %s --help", argv[i], HEXGPLC); } arg[nb_arg++] = argv[i]; } } /*-------------------------------------------------------------------------* * PL_FATAL_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Fatal_Error(char *format, ...) { va_list arg_ptr; va_start(arg_ptr, format); vfprintf(stderr, format, arg_ptr); va_end(arg_ptr); fprintf(stderr, "\n"); exit(1); } /*-------------------------------------------------------------------------* * DISPLAY_HELP * * * *-------------------------------------------------------------------------*/ void Display_Help(void) #define L(msg) fprintf(stderr, "%s\n", msg) { fprintf(stderr, "Usage: %s [OPTION]... [FILE...]", HEXGPLC); L(" "); L("Options:"); L(" --mangling demangling mode (default)"); L(" --decode same as --demangling"); L(" --mangling mangling mode"); L(" --encode same as --mangling"); L(" --relax encode/decode also predicate names (not only predicate indicators)"); L(" --strict encode/decode only predicate indicators (default)"); L(" --quote quote decoded predicate names (as done by writeq)"); L(" --no-quote do not quote decoded predicate names"); L(" --printf FORMAT pass encoded/decoded strings to printf with FORMAT"); L(" --aux-father decode auxiliary predicate as its father"); L(" --aux-father2 decode auxiliary predicate as its father + auxiliary number"); L(" --cmd-line command-line mode: encode/decode each argument of the command-line"); L(" -M or -H shortcut for --cmd-line --encode --relax"); L(" -D or -P shortcut for --cmd-line --decode --relax --quote"); L(" -h, --help print this help and exit"); L(" --version print version number and exit"); } ���������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/.gitignore����������������������������������������������������������������0000644�0001750�0001750�00000000065�13021324543�015460� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile SEARCH_PATH.c gprolog gprolog0 gplc hexgplc ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/copying.c�����������������������������������������������������������������0000644�0001750�0001750�00000010037�13021324543�015304� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog Compiler * * File : copying.c * * Descr.: copying notice for --version option * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /* This file included by top_comp.c, wam2ma.c, ma2asm.c,... */ /*-------------------------------------------------------------------------* * MK_COPYING_MESSAGE * * * *-------------------------------------------------------------------------*/ static char * Mk_Copying_Message(char *sub_part) { static char buff[256]; if (sub_part) sprintf(buff, "%s (%s) %s\n", sub_part, PROLOG_NAME, PROLOG_VERSION); else sprintf(buff, "%s %s\n", PROLOG_NAME, PROLOG_VERSION); strcat(buff, "By Daniel Diaz\n" #ifdef ADDITIONAL_INFORMATION ADDITIONAL_INFORMATION #endif PROLOG_COPYRIGHT "\n\n" PROLOG_NAME " comes with ABSOLUTELY NO WARRANTY.\n" "This is free software; see the source or the file\n" "named COPYING for copying conditions.\n"); return buff; } /*-------------------------------------------------------------------------* * DISPLAY_COPYING * * * *-------------------------------------------------------------------------*/ static void Display_Copying(char *sub_part) { fprintf(stderr, "%s", Mk_Copying_Message(sub_part)); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/top_level.c���������������������������������������������������������������0000644�0001750�0001750�00000020454�13021324543�015631� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog Top-level * * File : top_level.c * * Descr.: top-level command-line option checking * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include "../EnginePl/engine_pl.h" #include "../BipsPl/c_supp.h" #include "../BipsPl/inl_protos.h" #include "copying.c" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Display_Help(void); #define Check_Arg(i, str) (strncmp(argv[i], str, strlen(argv[i])) == 0) #define EXEC_CMD_LINE_GOAL X1_24657865635F636D645F6C696E655F676F616C #define PREDICATE_TOP_LEVEL X0_top_level Prolog_Prototype(PREDICATE_TOP_LEVEL, 0); Prolog_Prototype(EXEC_CMD_LINE_GOAL, 1); /*-------------------------------------------------------------------------* * To define a top_level simply compile an empty source file (Prolog or C) * * (linking the Prolog top-level is done by default). * * This file is because we want to take into account some options/arguments* *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * MAIN * * * * See comments in EnginePl/main.c about the use of the wrapper function. * *-------------------------------------------------------------------------*/ static int Main_Wrapper(int argc, char *argv[]) { int i; int new_argc = 0; char **new_argv; WamWord *entry_goal; int nb_entry_goal = 0; WamWord *consult_file; int nb_consult_file = 0; WamWord *query_goal; int nb_query_goal = 0; WamWord word; Pl_Start_Prolog(argc, argv); /* argc and argv will be changed */ new_argv = (char **) Malloc(sizeof(char *) * (argc + 1)); new_argv[new_argc++] = argv[0]; consult_file = (WamWord *) Malloc(sizeof(WamWord) * argc); entry_goal = (WamWord *) Malloc(sizeof(WamWord) * argc); query_goal = (WamWord *) Malloc(sizeof(WamWord) * argc); for (i = 1; i < argc; i++) { if (*argv[i] == '-' && argv[i][1] != '\0') { if (strcmp(argv[i], "--") == 0) { i++; break; } if (Check_Arg(i, "--version")) { Display_Copying("Prolog top-Level"); exit(0); } if (Check_Arg(i, "--init-goal")) { if (++i >= argc) Pl_Fatal_Error("Goal missing after --init-goal option"); A(0) = Tag_ATM(Pl_Create_Atom(argv[i])); Pl_Call_Prolog(Prolog_Predicate(EXEC_CMD_LINE_GOAL, 1)); Pl_Reset_Prolog(); continue; } if (Check_Arg(i, "--consult-file")) { if (++i >= argc) Pl_Fatal_Error("File missing after --consult-file option"); consult_file[nb_consult_file++] = Tag_ATM(Pl_Create_Atom(argv[i])); continue; } if (Check_Arg(i, "--entry-goal")) { if (++i >= argc) Pl_Fatal_Error("Goal missing after --entry-goal option"); entry_goal[nb_entry_goal++] = Tag_ATM(Pl_Create_Atom(argv[i])); continue; } if (Check_Arg(i, "--query-goal")) { if (++i >= argc) Pl_Fatal_Error("Goal missing after --query-goal option"); query_goal[nb_query_goal++] = Tag_ATM(Pl_Create_Atom(argv[i])); continue; } if (Check_Arg(i, "-h") || Check_Arg(i, "--help")) { Display_Help(); exit(0); } } /* unknown option is simply ignored (passed to Prolog) */ new_argv[new_argc++] = argv[i]; } while(i < argc) new_argv[new_argc++] = argv[i++]; new_argv[new_argc] = NULL; pl_os_argc = new_argc; pl_os_argv = new_argv; if (nb_consult_file) { word = Pl_Mk_Proper_List(nb_consult_file, consult_file); Pl_Blt_G_Assign(Tag_ATM(Pl_Create_Atom("$cmd_line_consult_file")), word); } Free(consult_file); if (nb_entry_goal) { word = Pl_Mk_Proper_List(nb_entry_goal, entry_goal); Pl_Blt_G_Assign(Tag_ATM(Pl_Create_Atom("$cmd_line_entry_goal")), word); } Free(entry_goal); if (nb_query_goal) { word = Pl_Mk_Proper_List(nb_query_goal, query_goal); Pl_Blt_G_Assign(Tag_ATM(Pl_Create_Atom("$cmd_line_query_goal")), word); } Free(query_goal); Pl_Reset_Prolog(); Pl_Call_Prolog(Prolog_Predicate(PREDICATE_TOP_LEVEL, 0)); Pl_Stop_Prolog(); return 0; } int main(int argc, char *argv[]) { return Main_Wrapper(argc, argv); } /*-------------------------------------------------------------------------* * DISPLAY_HELP * * * *-------------------------------------------------------------------------*/ static void Display_Help(void) #define L(msg) fprintf(stderr, "%s\n", msg) { fprintf(stderr, "Usage: %s [OPTION]... \n", TOP_LEVEL); L(""); L(" --consult-file FILE consult FILE inside the the top-level"); L(" --init-goal GOAL execute GOAL before entering the top-level"); L(" --entry-goal GOAL execute GOAL inside the top-level"); L(" --query-goal GOAL execute GOAL as a query for the top-level"); L(" -h, --help print this help and exit"); L(" --version print version number and exit"); L(" -- do not parse the rest of the command-line"); L(""); L("Report bugs to bug-prolog@gnu.org."); } #undef L ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/prolog_path.c�������������������������������������������������������������0000644�0001750�0001750�00000033235�13021324543�016157� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog Compiler * * File : prolog_path.c * * Descr.: Prolog installation path detector * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #ifndef _PROLOG_PATH_C #define _PROLOG_PATH_C /* This file is included by top_comp.c, engine.c and w32_console.c */ #include <stdio.h> #include <stdlib.h> #include <string.h> #if defined(_WIN32) || defined(__CYGWIN__) #include <windows.h> #include <io.h> #endif #if defined(__unix__) || defined(__CYGWIN__) #include <unistd.h> #include <sys/param.h> #endif #include "../EnginePl/gp_config.h" #if 0 #define DEBUG #endif static char *Get_Prolog_Path_From_Exec(char *str, int *devel_mode); static char *Is_A_Valid_Root(char *str, int *devel_mode); static char *Search_Path(char *file); #define COMPILER_EXE GPLC EXE_SUFFIX #if defined(_WIN32) || defined(__CYGWIN__) /*-------------------------------------------------------------------------* * READ_WINDOWS_REGISTRY * * * * key_name : name of the key * * key_type : type of the key (use Windows constant REG_SZ,...) * * buff : buffer to receive the value * * buff_size: size of the buffer * * * * return: 1 in case of success (0 else) * *-------------------------------------------------------------------------*/ static int Read_Windows_Registry(char *key_name, DWORD key_type, void *buff, DWORD buff_size) { DWORD dw_type; \ #define INIT_REGISTRY_ACCESS \ HKEY hkey_software, hkey_prolog; \ DWORD disp; \ int r; \ \ if (RegOpenKeyEx(HKEY_CURRENT_USER, "Software", 0, \ KEY_QUERY_VALUE, &hkey_software) != 0) \ return 0; \ \ if (RegCreateKeyEx(hkey_software, "GnuProlog", 0, \ NULL, 0, KEY_ALL_ACCESS, NULL, \ &hkey_prolog, &disp) != 0) \ { \ RegCloseKey(hkey_software); \ return 0; \ } INIT_REGISTRY_ACCESS; dw_type = key_type; /* useless in fact: it is a output arg */ memset(buff, 0, buff_size); r = RegQueryValueEx(hkey_prolog, key_name, 0, &dw_type, (LPBYTE) buff, &buff_size); if (r == ERROR_SUCCESS && dw_type != key_type) /* not good key type: et an error */ r++; RegCloseKey(hkey_prolog); RegCloseKey(hkey_software); return r == ERROR_SUCCESS; } #ifndef READ_REGISTRY_ONLY /* to avoid gcc warning on unused static fct */ /*-------------------------------------------------------------------------* * WRITE_WINDOWS_REGISTRY * * * * key_name : name of the key * * key_type : type of the key (use Windows constant REG_SZ,...) * * buff : buffer containing the value * * buff_size: size of the data to write * * * * return: 1 in case of success (0 else) * *-------------------------------------------------------------------------*/ static int Write_Windows_Registry(char *key_name, DWORD key_type, void *buff, DWORD buff_size) { INIT_REGISTRY_ACCESS; r = RegSetValueEx(hkey_prolog, key_name, 0, key_type, (LPBYTE) buff, buff_size); RegCloseKey(hkey_prolog); RegCloseKey(hkey_software); return r == ERROR_SUCCESS; } /*-------------------------------------------------------------------------* * DELETE_WINDOWS_REGISTRY * * * * key_name : name of the key * * * * return: 1 in case of success (0 else) * *-------------------------------------------------------------------------*/ static int Delete_Windows_Registry(char *key_name) { INIT_REGISTRY_ACCESS; r = RegDeleteValue(hkey_prolog, key_name); RegCloseKey(hkey_prolog); RegCloseKey(hkey_software); return r == ERROR_SUCCESS; } #endif /* !TOP_COMP_C */ #endif /*-------------------------------------------------------------------------* * GET_PROLOG_PATH * * * * Returns the GNU Prolog start path (or NULL) and if in devel_mode. * * The returned buffer can be written. * *-------------------------------------------------------------------------*/ static char * Get_Prolog_Path(char *argv0, int *devel_mode) { static char *prolog_path_cache = NULL; static int devel_mode_cache = 0; static char resolved[MAXPATHLEN]; char *p; if (prolog_path_cache != NULL) { *devel_mode = devel_mode_cache; return prolog_path_cache; } if ((p = getenv(ENV_VARIABLE)) != NULL) { strcpy(resolved, p); #ifdef DEBUG fprintf(stderr, "Prolog path from " ENV_VARIABLE ": %s\n", resolved); #endif if ((p = Is_A_Valid_Root(resolved, devel_mode)) != NULL) goto ok; } if (argv0 != NULL && (p = Get_Prolog_Path_From_Exec(argv0, devel_mode)) != NULL) { #ifdef DEBUG fprintf(stderr, "Prolog path from argv[0]: %s\n", p); #endif goto ok; } if ((p = Search_Path(COMPILER_EXE)) == NULL) { #if defined(_WIN32) || defined(__CYGWIN__) if (Read_Windows_Registry("RootPath", REG_SZ, resolved, sizeof(resolved)) && *resolved) { #ifdef DEBUG fprintf(stderr, "Prolog path from Registry: %s\n", resolved); #endif if ((p = Is_A_Valid_Root(resolved, devel_mode)) == NULL) goto ok; } #endif return NULL; } #ifdef DEBUG fprintf(stderr, GPLC " found from PATH: %s\n", p); #endif if ((p = Get_Prolog_Path_From_Exec(p, devel_mode)) != NULL) { ok: devel_mode_cache = *devel_mode; prolog_path_cache = strdup(p); return p; } return NULL; } /*-------------------------------------------------------------------------* * GET_PROLOG_PATH_FROM_EXEC * * * *-------------------------------------------------------------------------*/ static char * Get_Prolog_Path_From_Exec(char *str, int *devel_mode) { static char resolved[MAXPATHLEN]; char *p; #if defined(__unix__) || defined(__CYGWIN__) if (realpath(str, resolved) == NULL) return NULL; #else /* realpath useless under Win32 since SearchPath resolves it */ strcpy(resolved, str); #endif #ifdef DEBUG fprintf(stderr, "link resolution: %s\n", resolved); #endif p = resolved + strlen(resolved) - 1; while (p > resolved && !Is_Dir_Sep(*p)) /* skip exec_name */ p--; if (p == resolved) return NULL; while (p > resolved && Is_Dir_Sep(*p)) /* skip / */ p--; if (p == resolved) return NULL; while (p > resolved && !Is_Dir_Sep(*p)) /* skip previous dir name */ p--; if (p == resolved) return NULL; p[1] = '\0'; #ifdef DEBUG fprintf(stderr, "Prolog path from resolution: %s\n", resolved); #endif return Is_A_Valid_Root(resolved, devel_mode); } /*-------------------------------------------------------------------------* * IS_A_VALID_ROOT * * * *-------------------------------------------------------------------------*/ static char * Is_A_Valid_Root(char *str, int *devel_mode) { char *p; #ifdef DEBUG fprintf(stderr, "test if valid root and detect devel mode: %s\n", str); #endif p = str + strlen(str) - 1; while (p >= str && Is_Dir_Sep(*p)) p--; if (p < str) goto invalid; p++; strcpy(p, DIR_SEP_S "bin" DIR_SEP_S COMPILER_EXE); if (access(str, X_OK) == 0) { *p = '\0'; *devel_mode = 0; valid: #ifdef DEBUG fprintf(stderr, "valid root: %s\n", str); #endif return str; } /* for development mode, only test the existence of TopComp directory */ strcpy(p, DIR_SEP_S "TopComp"); if (access(str, F_OK) == 0) { *p = '\0'; *devel_mode = 1; #ifdef DEBUG fprintf(stderr, "development mode detected\n"); #endif goto valid; } invalid: #ifdef DEBUG fprintf(stderr, "invalid root: %s\n", str); #endif return NULL; } /*-------------------------------------------------------------------------* * SEARCH_PATH * * * *-------------------------------------------------------------------------*/ static char * Search_Path(char *file) { #if defined(__unix__) || defined(__CYGWIN__) char *path = getenv("PATH"); char *p; int l; static char buff[MAXPATHLEN]; if (path == NULL) return NULL; p = path; for (;;) { if ((p = strchr(path, ':')) != NULL) { l = p - path; strncpy(buff, path, l); } else { strcpy(buff, path); l = strlen(buff); } buff[l++] = DIR_SEP_C; strcpy(buff + l, file); if (access(buff, X_OK) == 0) return buff; if (p == NULL) break; path = p + 1; } return NULL; #else static char buff[MAXPATHLEN]; char *file_part; if (SearchPath(NULL, file, ".exe", MAXPATHLEN, buff, &file_part) == 0) return NULL; return buff; #endif } #ifdef USE_ALONE /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { int devel_mode = 0; char *start_path = Get_Prolog_Path(); if (start_path == NULL) { puts("error: GNU Prolog path not found"); return 1; } if (*start_path == '@') /* development mode */ { start_path++; devel_mode = 1; } puts(start_path); if (argc > 1 && devel_mode) puts("development mode"); return 0; } #endif #endif /* _PROLOG_PATH_C */ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/top_comp.c����������������������������������������������������������������0000644�0001750�0001750�00000125566�13021324543�015472� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog Compiler * * File : top_comp.c * * Descr.: compiler main (shell) program * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "../EnginePl/gp_config.h" #include <stdio.h> #include <stdlib.h> #include <stdarg.h> #include <string.h> #include <sys/stat.h> #include <errno.h> #include <ctype.h> #include <sys/types.h> #ifdef _WIN32 #include <windows.h> #include <process.h> #include <fcntl.h> #include <io.h> #else #include <dirent.h> #include <unistd.h> #include <sys/param.h> #include <sys/wait.h> #endif #include "../EnginePl/pl_params.h" #include "../EnginePl/wam_regs.h" #include "decode_hexa.c" #include "copying.c" #define READ_REGISTRY_ONLY #include "prolog_path.c" #include "../EnginePl/machine1.c" #if 0 #define DEBUG #endif /*---------------------------------* * Constants * *---------------------------------*/ #define CMD_LINE_MAX_OPT 8192 #define CMD_LINE_LENGTH (MAXPATHLEN + CMD_LINE_MAX_OPT + 1) #define TEMP_FILE_PREFIX GPLC #define OBJ_FILE_ALL_PL_BIPS "all_pl_bips" #define OBJ_FILE_ALL_FD_BIPS "all_fd_bips" #define OBJ_FILE_TOP_LEVEL "top_level" #define OBJ_FILE_DEBUGGER "debugger" #define EXE_FILE_PL2WAM "pl2wam" #define EXE_FILE_WAM2MA "wam2ma" #define EXE_FILE_MA2ASM "ma2asm" #define EXE_FILE_ASM AS #define EXE_FILE_FD2C "fd2c" #define EXE_FILE_CC CC #define EXE_FILE_LINK CC #define EXE_FILE_STRIP STRIP #define FILE_PL 0 #define FILE_WAM 1 #define FILE_MA 2 #define FILE_ASM 3 #define FILE_OBJ 4 #define FILE_FD 5 #define FILE_C 6 #define FILE_LINK 7 #define LINK_OPTION 8 #define PL_SUFFIX PROLOG_FILE_SUFFIX #define PL_SUFFIX_ALTERNATE PROLOG_FILE_SUFFIXES_ALT #define WAM_SUFFIX ".wam" #define WBC_SUFFIX ".wbc" #define MA_SUFFIX ".ma" #define FD_SUFFIX ".fd" #define C_SUFFIX ".c" #define C_SUFFIX_ALTERNATE "|.C|.cc|.CC|.cxx|.CXX|.c++|.C++|.cpp|.CPP|" #define CC_COMPILE_OPT "-c " #define CC_INCLUDE_OPT "-I" /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { char *name; char *suffix; char *file_part; int type; char *work_name1; char *work_name2; } FileInf; typedef struct { char *exe_name; char opt[CMD_LINE_MAX_OPT]; char *out_opt; } CmdInf; /*---------------------------------* * Global Variables * *---------------------------------*/ char *start_path; int devel_mode = 0; char *devel_dir[] = { "EnginePl", "BipsPl", "EngineFD", "BipsFD", "Linedit", "W32GUICons", NULL }; FileInf *file_lopt; int nb_file_lopt = 0; int stop_after = FILE_LINK; int verbose = 0; char *file_name_out = NULL; int pl_def_local_size = -1; int pl_def_global_size = -1; int pl_def_trail_size = -1; int pl_def_cstr_size = -1; int pl_def_max_atom = -1; int pl_fixed_sizes = 0; int needs_stack_file = 0; int bc_mode = 0; int gui_console = 0; int no_top_level = 0; int min_pl_bips = 0; int min_fd_bips = 0; int no_debugger = 0; int no_pl_lib = 0; int no_fd_lib = 0; int no_fd_lib_warn = 0; int strip = 0; int no_decode_hex = 0; char warn_str[1024] = ""; char *temp_dir = NULL; int no_del_temp_files = 0; /* Almost each string ends with a space. However, executable names * EXE_XXX_NAME do not end with a space (so they can be used in Search_Path) * thus options must begin with a space (and end with a space too). */ CmdInf cmd_pl2wam = { EXE_FILE_PL2WAM, " ", "-o " }; CmdInf cmd_wam2ma = { EXE_FILE_WAM2MA, " ", "-o " }; CmdInf cmd_ma2asm = { EXE_FILE_MA2ASM, " ", "-o " }; CmdInf cmd_asm = { EXE_FILE_ASM, " " ASFLAGS " ", "-o " }; CmdInf cmd_fd2c = { EXE_FILE_FD2C, " ", "-o " }; CmdInf cmd_cc = { EXE_FILE_CC, " ", CC_OBJ_NAME_OPT }; /* see below for others flags */ CmdInf cmd_link = { EXE_FILE_LINK, " " CFLAGS_MACHINE " ", CC_EXE_NAME_OPT }; char *cc_fd2c_flags = CFLAGS " "; char *suffixes[] = { PL_SUFFIX, WAM_SUFFIX, MA_SUFFIX, ASM_SUFFIX, OBJ_SUFFIX, FD_SUFFIX, C_SUFFIX, NULL }; /*---------------------------------* * Function Prototypes * *---------------------------------*/ char *Search_Path(char *file); void Determine_Pathnames(void); void Compile_Files(void); void Create_Output_File_Name(FileInf *f, char *buff); void New_Work_File(FileInf *f, int stage, int stop_after); void Free_Work_File2(FileInf *f); void Compile_Cmd(CmdInf *c, FileInf *f); void Link_Cmd(void); void Exec_One_Cmd(char *str, int no_decode_hex); int Spawn_Decode_Hex(char *arg[]); void Delete_Temp_File(char *name); int Find_File(char *file, char *suff, char *file_path, int ignore_error); char *Find_Suffix(char *suffixes, char *suffix); void Pl_Fatal_Error(char *format, ...); void Parse_Arguments(int argc, char *argv[]); void Display_Help(void); #define Record_Link_Warn_Option(i) \ sprintf(warn_str + strlen(warn_str), "%s ", argv[i]) #define Before_Cmd(cmd) \ if (verbose) \ fprintf(stderr, "%s\n", cmd) #define After_Cmd(error) \ if (error) \ Pl_Fatal_Error("compilation failed"); /* Pl_Fatal_Error("compilation failed (returned status: %d hexa: %x)", status, status) */ char *last_opt; #define Check_Arg(i, str) (last_opt = str, strncmp(argv[i], str, strlen(argv[i])) == 0) #define Add_Last_Option(opt) sprintf(opt + strlen(opt), "%s ", last_opt) #define Add_Option(i, opt) sprintf(opt + strlen(opt), "%s ", argv[i]) /*-------------------------------------------------------------------------* * MAIN * * * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { char **pdev; #ifdef _WIN32 setbuf(stdout, NULL); setbuf(stderr, NULL); #endif file_lopt = (FileInf *) calloc(argc + 1, sizeof(FileInf)); if (file_lopt == NULL) Pl_Fatal_Error("memory allocation fault"); Parse_Arguments(argc, argv); if (verbose) fprintf(stderr, "\n"); start_path = Get_Prolog_Path(argv[0], &devel_mode); if (start_path == NULL) Pl_Fatal_Error("cannot find the path for %s, set environment variable %s", PROLOG_NAME, ENV_VARIABLE); strcat(cmd_cc.opt, CFLAGS_MACHINE " " CFLAGS_REGS CC_COMPILE_OPT); if (devel_mode) for (pdev = devel_dir; *pdev; pdev++) sprintf(cmd_cc.opt + strlen(cmd_cc.opt), "%s%s" DIR_SEP_S "%s ", CC_INCLUDE_OPT, start_path, *pdev); else sprintf(cmd_cc.opt + strlen(cmd_cc.opt), "%s%s" DIR_SEP_S "include ", CC_INCLUDE_OPT, start_path); strcat(cmd_link.opt, LDFLAGS " "); if (verbose) fprintf(stderr, "Path used: %s %s\n", start_path, (devel_mode) ? "(development mode)" : ""); Compile_Files(); return 0; } /*-------------------------------------------------------------------------* * COMPILE_FILES * * * *-------------------------------------------------------------------------*/ void Compile_Files(void) { FileInf *f; int stage; int stage_end; int l; FILE *fd; if (stop_after < FILE_LINK) { if (*warn_str) fprintf(stderr, "link not done - ignored option(s): %s\n", warn_str); stage_end = stop_after; needs_stack_file = 0; if (bc_mode) { suffixes[FILE_WAM] = WBC_SUFFIX; strcat(cmd_pl2wam.opt, "--wam-for-byte-code "); } } else stage_end = FILE_ASM; if (needs_stack_file) { f = file_lopt + nb_file_lopt; f->work_name2 = NULL; New_Work_File(f, FILE_WAM, 10000); /* to create work_name2 */ f->name = f->work_name2; f->suffix = f->name + strlen(f->name) - strlen(suffixes[FILE_MA]); f->type = FILE_MA; f->work_name1 = f->name, f->work_name2 = NULL; if (verbose) fprintf(stderr, "creating stack size file: %s\n", f->name); if ((fd = fopen(f->name, "wt")) == NULL) Pl_Fatal_Error("cannot open stack size file (%s)", f->name); if (pl_def_local_size >= 0) fprintf(fd, "long global pl_def_local_size = %d\n", pl_def_local_size); if (pl_def_global_size >= 0) fprintf(fd, "long global pl_def_global_size = %d\n", pl_def_global_size); if (pl_def_trail_size >= 0) fprintf(fd, "long global pl_def_trail_size = %d\n", pl_def_trail_size); if (pl_def_cstr_size >= 0) fprintf(fd, "long global pl_def_cstr_size = %d\n", pl_def_cstr_size); if (pl_def_max_atom >= 0) fprintf(fd, "long global pl_def_max_atom = %d\n", pl_def_max_atom); if (pl_fixed_sizes) fprintf(fd, "long global pl_fixed_sizes = 1\n"); fclose(fd); } if (verbose) fprintf(stderr, "\n*** Compiling\n"); for (f = file_lopt; f->name; f++) { if (f->type == LINK_OPTION) continue; if (verbose && (f->type == FILE_FD || f->type == FILE_C || f->type <= stage_end)) fprintf(stderr, "\n--- file: %s\n", f->name); if (f->type == FILE_FD && stop_after >= FILE_ASM) { stage = FILE_FD; /* to generate the correct C suffix */ New_Work_File(f, stage, (stop_after == FILE_FD) ? stop_after : 10000); Compile_Cmd(&cmd_fd2c, f); if (stop_after != FILE_FD) { stage = FILE_ASM; /* to generate the correct obj suffix */ New_Work_File(f, stage, stop_after); l = strlen(cmd_cc.opt); /* add fd2c C options */ strcpy(cmd_cc.opt + l, cc_fd2c_flags); Compile_Cmd(&cmd_cc, f); cmd_cc.opt[l] = '\0'; /* remove them */ } goto free_work_file; } if (f->type == FILE_C && stop_after >= FILE_ASM && stop_after != FILE_FD) { stage = FILE_ASM; /* to generate the correct obj suffix */ New_Work_File(f, stage, stop_after); Compile_Cmd(&cmd_cc, f); goto free_work_file; } if (f->type == FILE_FD || f->type == FILE_C || stop_after == FILE_FD || f->type > stop_after) { fprintf(stderr, "unused input file: %s\n", f->name); continue; } for (stage = f->type; stage <= stage_end; stage++) { New_Work_File(f, stage, stop_after); switch (stage) { case FILE_PL: Compile_Cmd(&cmd_pl2wam, f); break; case FILE_WAM: Compile_Cmd(&cmd_wam2ma, f); break; case FILE_MA: Compile_Cmd(&cmd_ma2asm, f); if (needs_stack_file && f == file_lopt + nb_file_lopt && !no_del_temp_files) { if (verbose) fprintf(stderr, "deleting stack size file\n"); Delete_Temp_File(f->name); } break; case FILE_ASM: Compile_Cmd(&cmd_asm, f); break; } } free_work_file: Free_Work_File2(f); /* to suppress last useless temp file */ } if (stop_after < FILE_LINK) return; if (verbose) fprintf(stderr, "\n*** Linking\n\n"); Link_Cmd(); /* removing temp files after link */ for (f = file_lopt; f->name; f++) if (f->work_name1 != f->name) /* also ok if f->type == LINK_OPTION */ Delete_Temp_File(f->work_name1); } /*-------------------------------------------------------------------------* * CREATE_OUTPUT_FILE_NAME * * * *-------------------------------------------------------------------------*/ void Create_Output_File_Name(FileInf *f, char *buff) { char *p; int l; static int counter = 0; for(p = file_name_out; *p; p++) { if (*p != '%') *buff++ = *p; else switch(* ++p) { case 'd': /* %d = the directory part */ strcpy(buff, f->name); l = f->file_part - f->name; buff += l; break; case 'f': /* %f = the whole file name */ strcpy(buff, f->name); buff += strlen(buff); break; case 'F': /* %F = the whole file name (without dir) */ strcpy(buff, f->file_part); buff += strlen(buff); break; case 'p': /* %p = the prefix file name */ strcpy(buff, f->name); l = f->suffix - f->name; buff += l; break; case 'P': /* %P = the prefix file name (without dir) */ strcpy(buff, f->file_part); l = f->suffix - f->file_part; buff += l; break; case 's': /* %s = the suffix */ strcpy(buff, f->suffix); buff += strlen(buff); break; case 'c': /* %c = a counter */ sprintf(buff, "%d", ++counter); buff += strlen(buff); break; default: *buff++ = '%'; /* no special % sequence */ *buff++ = *p; } } *buff = '\0'; } /*-------------------------------------------------------------------------* * NEW_WORK_FILE * * * *-------------------------------------------------------------------------*/ void New_Work_File(FileInf *f, int stage, int stop_after) { static char buff[MAXPATHLEN]; char *p; if (stage < stop_after) /* intermediate stage */ { p = Pl_M_Tempnam(temp_dir, TEMP_FILE_PREFIX); sprintf(buff, "%s%s", p, suffixes[stage + 1]); free(p); } else /* final stage */ if (file_name_out) /* specified output filename */ Create_Output_File_Name(f, buff); else { strcpy(buff, f->name); strcpy(buff + (f->suffix - f->name), suffixes[stage + 1]); } Free_Work_File2(f); f->work_name2 = strdup(buff); } /*-------------------------------------------------------------------------* * FREE_WORK_FILE2 * * * *-------------------------------------------------------------------------*/ void Free_Work_File2(FileInf *f) { if (f->work_name2 != NULL) { if (f->work_name1 != f->name) Delete_Temp_File(f->work_name1); f->work_name1 = f->work_name2; } } /*-------------------------------------------------------------------------* * COMPILE_CMD * * * *-------------------------------------------------------------------------*/ void Compile_Cmd(CmdInf *c, FileInf *f) { static char buff[CMD_LINE_LENGTH]; sprintf(buff, "%s%s%s%s %s", c->exe_name, c->opt, c->out_opt, f->work_name2, f->work_name1); Exec_One_Cmd(buff, 1); } /*-------------------------------------------------------------------------* * LINK_CMD * * * *-------------------------------------------------------------------------*/ void Link_Cmd(void) { static char file_out[MAXPATHLEN]; static char buff[CMD_LINE_LENGTH]; FileInf *f; #ifdef _MSC_VER int has_gui_console = 0; #endif if (no_fd_lib == 0 && no_fd_lib_warn) { if (!Find_File(LIB_BIPS_FD, "", buff, 1) || !Find_File(LIB_ENGINE_FD, "", buff + strlen(buff), 1)) no_fd_lib = min_fd_bips = 1; } if (file_name_out == NULL) file_name_out = "%p"; /* will reuse first file name */ for (f = file_lopt; f->type == LINK_OPTION; f++) ; /* use first file name by default */ Create_Output_File_Name(f, file_out); file_name_out = file_out; /* with MSVC: if at run-time we don't find cl.exe we use link.exe * it is a workaround for users who have installed a binary version * (from a setup.exe) compiled with cl.exe but who don't have cl.exe */ #ifdef _MSC_VER { char *dont_care; if (SearchPath(NULL, cmd_link.exe_name, ".exe", CMD_LINE_LENGTH, buff, &dont_care) && getenv("USE_LINKER") == NULL) #endif sprintf(buff, "%s%s%s%s ", cmd_link.exe_name, cmd_link.opt, cmd_link.out_opt, file_name_out); #ifdef _MSC_VER else { if (verbose) printf("%s.exe not found ! we use link.exe\nIn case of error check it is really the MS link.exe which is used and not the cygwin link utility\n", cmd_link.exe_name); sprintf(buff, "link /nologo /stack:8000000 /out:%s ", file_name_out); } } #endif /* f->work_name1 is OK for LINK_OPTION */ for (f = file_lopt; f->name; f++) sprintf(buff + strlen(buff), "%s ", f->work_name1); if (!min_pl_bips) { Find_File(OBJ_FILE_ALL_PL_BIPS, OBJ_SUFFIX, buff + strlen(buff), 0); strcat(buff, " "); } #ifndef NO_USE_FD_SOLVER if (!min_fd_bips) { Find_File(OBJ_FILE_ALL_FD_BIPS, OBJ_SUFFIX, buff + strlen(buff), 0); strcat(buff, " "); } #endif if (!no_top_level) { Find_File(OBJ_FILE_TOP_LEVEL, OBJ_SUFFIX, buff + strlen(buff), 0); strcat(buff, " "); } if (!no_debugger) { Find_File(OBJ_FILE_DEBUGGER, OBJ_SUFFIX, buff + strlen(buff), 0); strcat(buff, " "); } #ifndef NO_USE_FD_SOLVER if (!no_fd_lib) { Find_File(LIB_BIPS_FD, "", buff + strlen(buff), 0); strcat(buff, " "); Find_File(LIB_ENGINE_FD, "", buff + strlen(buff), 0); strcat(buff, " "); } #endif if (!no_pl_lib) { Find_File(LIB_BIPS_PL, "", buff + strlen(buff), 0); strcat(buff, " "); } Find_File(LIB_ENGINE_PL, "", buff + strlen(buff), 0); strcat(buff, " "); #ifndef NO_USE_LINEDIT Find_File(LIB_LINEDIT, "", buff + strlen(buff), 0); strcat(buff, " "); #endif strcat(buff, LDLIBS " "); if (!no_pl_lib && gui_console) { /* modify Linedit/Makefile.in to follow this list of ld objects */ Find_File("w32gc_interf", OBJ_SUFFIX, buff + strlen(buff), 0); strcat(buff, " "); Find_File("win_exe_icon", ".res", buff + strlen(buff), 1); strcat(buff, " "); #ifdef _MSC_VER has_gui_console = 1; #endif } #ifdef _MSC_VER if (*buff != 'l' && *buff != 'L') /* it is not link.exe (use strstr ?)! */ strcat(buff, "/link "); strcat(buff, "/ignore:4089 "); if (!has_gui_console) strcat(buff, "/subsystem:console "); #ifdef M_x86_64 strcat(buff, "/LARGEADDRESSAWARE:NO "); #endif #endif Exec_One_Cmd(buff, no_decode_hex); if (strip && *EXE_FILE_STRIP != ':' && *EXE_FILE_STRIP != '\0') { sprintf(buff, "%s %s%s", EXE_FILE_STRIP, file_name_out, EXE_SUFFIX); Exec_One_Cmd(buff, 1); } } /*-------------------------------------------------------------------------* * EXEC_ONE_CMD * * * *-------------------------------------------------------------------------*/ void Exec_One_Cmd(char *cmd, int no_decode_hex) { #if 1 int status; static char *arg[2] = { NULL, (char *) 1 }; arg[0] = cmd; Before_Cmd(cmd); if (no_decode_hex == 1) status = Pl_M_Spawn(arg); else status = Spawn_Decode_Hex(arg); if (status == -1) { fprintf(stderr, "error trying to execute "); perror(arg[0]); } if (status == -2) fprintf(stderr, "error trying to execute %s: unknown error", arg[0]); After_Cmd(status); #else int status; Before_Cmd(cmd); #ifdef DEBUG fprintf(stderr, "executing system() for: %s\n", cmd); #endif status = system(cmd); status >>= 8; if (status == -1 || status == 127) Pl_Fatal_Error("error trying to execute %s", cmd); After_Cmd(status); #endif } /*-------------------------------------------------------------------------* * SPAWN_DECODE_HEX * * * *-------------------------------------------------------------------------*/ int Spawn_Decode_Hex(char *arg[]) { int pid, status; FILE *f_out; static char buff[CMD_LINE_LENGTH]; pid = Pl_M_Spawn_Redirect(arg, 0, NULL, &f_out, &f_out); if (pid == -1 || pid == -2) return pid; for (;;) { if (fgets(buff, sizeof(buff), f_out)) /* to avoid gcc warning warn_unused_result */ { } if (feof(f_out)) break; #ifndef DEBUG fputs(Decode_Hexa_Line(buff, "predicate(%s)", 1, 1, 1), stderr); #else fprintf(stderr, "piped line:%s", Decode_Hexa_Line(buff, "predicate(%s)", 1, 1, 1)); #endif } if (fclose(f_out)) return -1; status = Pl_M_Get_Status(pid); #ifdef DEBUG fprintf(stderr, "error status: %d\n", status); #endif return status; } /*-------------------------------------------------------------------------* * DELETE_TEMP_FILE * * * *-------------------------------------------------------------------------*/ void Delete_Temp_File(char *name) { if (no_del_temp_files) return; #if 1 if (verbose) fprintf(stderr, "delete %s\n", name); #endif unlink(name); } /*-------------------------------------------------------------------------* * FIND_FILE * * * *-------------------------------------------------------------------------*/ int Find_File(char *file, char *suff, char *file_path, int ignore_error) { char name[MAXPATHLEN]; char **pdev; char *cur_end = file_path; sprintf(name, "%s%s", file, suff); if (!devel_mode) { sprintf(file_path, "%s" DIR_SEP_S "lib" DIR_SEP_S "%s", start_path, name); if (access(file_path, F_OK) == 0) return 1; } else for (pdev = devel_dir; *pdev; pdev++) { sprintf(file_path, "%s" DIR_SEP_S "%s" DIR_SEP_S "%s", start_path, *pdev, name); if (access(file_path, F_OK) == 0) return 1; } if (!ignore_error) Pl_Fatal_Error("cannot locate file %s", name); *cur_end = '\0'; return 0; } /*-------------------------------------------------------------------------* * FIND_SUFFIX * * * *-------------------------------------------------------------------------*/ char * Find_Suffix(char *suffixes, char *suffix) { char *p; /* TODO: use strcasestr (must be tested in configure.in) */ if ((p = strstr(suffixes, suffix)) && p[-1] == '|' && p[strlen(suffix)] == '|') return p; return NULL; } /*-------------------------------------------------------------------------* * PL_FATAL_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Fatal_Error(char *format, ...) { FileInf *f; va_list arg_ptr; va_start(arg_ptr, format); vfprintf(stderr, format, arg_ptr); va_end(arg_ptr); fprintf(stderr, "\n"); if (no_del_temp_files) exit(1); if (verbose) fprintf(stderr, "deleting temporary files before exit\n"); for (f = file_lopt; f->name; f++) { /* also ok if f->type == LINK_OPTION */ if (f->work_name1 && f->work_name1 != f->name && (file_name_out == NULL || strcasecmp(f->work_name1, file_name_out) != 0)) Delete_Temp_File(f->work_name1); if (f->work_name2 && f->work_name2 != f->name && (file_name_out == NULL || strcasecmp(f->work_name2, file_name_out) != 0)) Delete_Temp_File(f->work_name2); } exit(1); } /*-------------------------------------------------------------------------* * PARSE_ARGUMENTS * * * *-------------------------------------------------------------------------*/ void Parse_Arguments(int argc, char *argv[]) { int i, file_name_out_i; char **p, *q; FileInf *f = file_lopt; int nb_file = 0; for (i = 1; i < argc; i++) { if (*argv[i] == '-' && argv[i][1] != '\0') { if (Check_Arg(i, "-o") || Check_Arg(i, "--output")) { file_name_out_i = i; if (++i >= argc) Pl_Fatal_Error("FILE missing after %s option", last_opt); file_name_out = argv[i]; continue; } if (Check_Arg(i, "-W") || Check_Arg(i, "--wam-for-native")) { stop_after = FILE_PL; bc_mode = 0; continue; } if (Check_Arg(i, "-w") || Check_Arg(i, "--wam-for-byte-code")) { stop_after = FILE_PL; bc_mode = 1; continue; } if (Check_Arg(i, "-M") || Check_Arg(i, "--mini-assembly")) { stop_after = FILE_WAM; bc_mode = 0; continue; } if (Check_Arg(i, "-S") || Check_Arg(i, "--assembly")) { stop_after = FILE_MA; bc_mode = 0; continue; } if (Check_Arg(i, "-c") || Check_Arg(i, "--object")) { stop_after = FILE_ASM; bc_mode = 0; continue; } if (Check_Arg(i, "-F") || Check_Arg(i, "--fd-to-c")) { stop_after = FILE_FD; bc_mode = 0; continue; } if (Check_Arg(i, "--comment")) { Add_Last_Option(cmd_wam2ma.opt); Add_Last_Option(cmd_ma2asm.opt); continue; } if (Check_Arg(i, "--inline-asm") || Check_Arg(i, "--full-inline-asm") || Check_Arg(i, "--pic") || Check_Arg(i, "-fPIC")) /* TODO pass --pic to gcc as -fPIC for C code */ { Add_Last_Option(cmd_ma2asm.opt); continue; } if (Check_Arg(i, "--temp-dir")) { if (++i >= argc) Pl_Fatal_Error("PATH missing after %s option", last_opt); temp_dir = argv[i]; continue; } if (Check_Arg(i, "--no-del-temp-files")) { no_del_temp_files = 1; continue; } if (Check_Arg(i, "--no-decode-hexa") || Check_Arg(i, "--no-demangling")) { no_decode_hex = 1; continue; } if (Check_Arg(i, "--version") || Check_Arg(i, "-v") || Check_Arg(i, "--verbose")) { Display_Copying("Prolog compiler"); if (Check_Arg(i, "--version")) exit(0); verbose = 1; continue; } if (Check_Arg(i, "-h") || Check_Arg(i, "--help")) { Display_Help(); exit(0); } if (Check_Arg(i, "--pl-state")) { if (++i >= argc) Pl_Fatal_Error("FILE missing after %s option", last_opt); if (access(argv[i], R_OK) != 0) { perror(argv[i]); exit(1); } Add_Last_Option(cmd_pl2wam.opt); last_opt = argv[i]; Add_Last_Option(cmd_pl2wam.opt); continue; } if (Check_Arg(i, "--wam-comment")) { if (++i >= argc) Pl_Fatal_Error("COMMENT missing after %s option", last_opt); Add_Last_Option(cmd_pl2wam.opt); last_opt = argv[i]; Add_Last_Option(cmd_pl2wam.opt); continue; } if (Check_Arg(i, "--no-susp-warn") || Check_Arg(i, "--no-singl-warn") || Check_Arg(i, "--no-redef-error") || Check_Arg(i, "--foreign-only") || Check_Arg(i, "--no-call-c") || Check_Arg(i, "--no-inline") || Check_Arg(i, "--no-reorder") || Check_Arg(i, "--no-reg-opt") || Check_Arg(i, "--min-reg-opt") || Check_Arg(i, "--no-opt-last-subterm") || Check_Arg(i, "--fast-math") || Check_Arg(i, "--keep-void-inst") || Check_Arg(i, "--compile-msg") || Check_Arg(i, "--statistics")) { Add_Last_Option(cmd_pl2wam.opt); continue; } if (Check_Arg(i, "--c-compiler")) { if (++i >= argc) Pl_Fatal_Error("FILE missing after %s option", last_opt); cmd_cc.exe_name = argv[i]; if (strcmp(cmd_link.exe_name, EXE_FILE_LINK) == 0) cmd_link.exe_name = argv[i]; continue; } if (Check_Arg(i, "--linker")) { if (++i >= argc) Pl_Fatal_Error("FILE missing after %s option", last_opt); cmd_link.exe_name = argv[i]; continue; } if (Check_Arg(i, "-C")) { if (++i >= argc) Pl_Fatal_Error("OPTION missing after %s option", last_opt); Add_Option(i, cmd_cc.opt); /* if C options specified do not take into account fd2c default C options */ cc_fd2c_flags = ""; continue; } if (Check_Arg(i, "-A")) { if (++i >= argc) Pl_Fatal_Error("OPTION missing after %s option", last_opt); Add_Option(i, cmd_asm.opt); continue; } if (Check_Arg(i, "--local-size")) { Record_Link_Warn_Option(i); if (++i >= argc) Pl_Fatal_Error("SIZE missing after %s option", last_opt); pl_def_local_size = strtol(argv[i], &q, 10); if (*q || pl_def_local_size < 0) Pl_Fatal_Error("invalid stack size (%s)", argv[i]); Record_Link_Warn_Option(i); needs_stack_file = 1; continue; } if (Check_Arg(i, "--global-size")) { Record_Link_Warn_Option(i); if (++i >= argc) Pl_Fatal_Error("SIZE missing after %s option", last_opt); pl_def_global_size = strtol(argv[i], &q, 10); if (*q || pl_def_global_size < 0) Pl_Fatal_Error("invalid stack size (%s)", argv[i]); Record_Link_Warn_Option(i); needs_stack_file = 1; continue; } if (Check_Arg(i, "--trail-size")) { Record_Link_Warn_Option(i); if (++i >= argc) Pl_Fatal_Error("SIZE missing after %s option", last_opt); pl_def_trail_size = strtol(argv[i], &q, 10); if (*q || pl_def_trail_size < 0) Pl_Fatal_Error("invalid stack size (%s)", argv[i]); Record_Link_Warn_Option(i); needs_stack_file = 1; continue; } if (Check_Arg(i, "--cstr-size")) { Record_Link_Warn_Option(i); if (++i >= argc) Pl_Fatal_Error("SIZE missing after %s option", last_opt); pl_def_cstr_size = strtol(argv[i], &q, 10); if (*q || pl_def_cstr_size < 0) Pl_Fatal_Error("invalid stack size (%s)", argv[i]); Record_Link_Warn_Option(i); needs_stack_file = 1; continue; } if (Check_Arg(i, "--max-atom")) { Record_Link_Warn_Option(i); if (++i >= argc) Pl_Fatal_Error("SIZE missing after %s option", last_opt); pl_def_max_atom = strtol(argv[i], &q, 10); if (*q || pl_def_max_atom < 0) Pl_Fatal_Error("invalid max atom (%s)", argv[i]); Record_Link_Warn_Option(i); needs_stack_file = 1; continue; } if (Check_Arg(i, "--fixed-sizes")) { Record_Link_Warn_Option(i); pl_fixed_sizes = 1; needs_stack_file = 1; continue; } if (Check_Arg(i, "--no-top-level")) { Record_Link_Warn_Option(i); no_top_level = 1; no_debugger = 1; continue; } if (Check_Arg(i, "--gui-console")) { #ifdef W32_GUI_CONSOLE Record_Link_Warn_Option(i); gui_console = 1; #else fprintf(stderr, "Warning: Win32 GUI Console not available\n"); #endif continue; } if (Check_Arg(i, "--no-debugger")) { Record_Link_Warn_Option(i); no_debugger = 1; continue; } if (Check_Arg(i, "--min-pl-bips")) { Record_Link_Warn_Option(i); min_pl_bips = 1; continue; } if (Check_Arg(i, "--min-fd-bips")) { Record_Link_Warn_Option(i); min_fd_bips = 1; continue; } if (Check_Arg(i, "--min-bips") || Check_Arg(i, "--min-size")) { Record_Link_Warn_Option(i); no_top_level = no_debugger = min_pl_bips = min_fd_bips = 1; if (Check_Arg(i, "--min-size")) strip = 1; continue; } if (Check_Arg(i, "--no-pl-lib")) { Record_Link_Warn_Option(i); no_pl_lib = no_fd_lib = 1; no_top_level = no_debugger = min_pl_bips = min_fd_bips = 1; continue; } if (Check_Arg(i, "--no-fd-lib")) { Record_Link_Warn_Option(i); no_fd_lib = min_fd_bips = 1; continue; } if (Check_Arg(i, "--no-fd-lib-warn")) { Record_Link_Warn_Option(i); no_fd_lib_warn = 1; continue; } if (Check_Arg(i, "-s") || Check_Arg(i, "--strip")) { Record_Link_Warn_Option(i); strip = 1; continue; } if (Check_Arg(i, "-L")) { Record_Link_Warn_Option(i); if (++i >= argc) Pl_Fatal_Error("OPTION missing after %s option", last_opt); Record_Link_Warn_Option(i); #if 0 Add_Option(i, cmd_link.opt); #else f->name = f->work_name1 = argv[i]; f->type = LINK_OPTION; nb_file_lopt++; f++; #endif continue; } Pl_Fatal_Error("unknown option %s - try %s --help", argv[i], GPLC); } f->name = argv[i]; if ((f->suffix = strrchr(argv[i], '.')) == NULL) f->suffix = argv[i] + strlen(argv[i]); for(q = f->suffix; q >= f->name; q--) if (*q == '/' #ifdef _WIN32 || *q == '\\' #endif ) break; f->file_part = q + 1; if (Find_Suffix(PL_SUFFIX_ALTERNATE, f->suffix)) f->type = FILE_PL; else if (Find_Suffix(PL_SUFFIX_ALTERNATE, f->suffix)) f->type = FILE_C; else { f->type = FILE_LINK; for (p = suffixes; *p; p++) if (strcasecmp(*p, f->suffix) == 0) { f->type = p - suffixes; break; } } f->work_name1 = f->name; f->work_name2 = NULL; if (f->type != FILE_LINK && access(f->name, R_OK) != 0) { perror(f->name); exit(1); } nb_file_lopt++; nb_file++; f++; } if (f == file_lopt) { if (verbose) exit(0); /* --verbose with no files same as --version */ else Pl_Fatal_Error("no input file specified"); } f->name = NULL; if (nb_file > 1 && stop_after < FILE_LINK && file_name_out && strchr(file_name_out, '%') == NULL) { fprintf(stderr, "named output file ignored with multiples output (or use meta-characters, e.g. %%p)\n"); Record_Link_Warn_Option(file_name_out_i); Record_Link_Warn_Option(file_name_out_i + 1); file_name_out = NULL; } } /*-------------------------------------------------------------------------* * DISPLAY_HELP * * * *-------------------------------------------------------------------------*/ void Display_Help(void) #define L(msg) fprintf(stderr, "%s\n", msg) { fprintf(stderr, "Usage: %s [OPTION]... FILE...\n", GPLC); L(" "); L("General options:"); L(" -o FILE, --output FILE set output file name (see below)"); L(" -W, --wam-for-native stop after producing WAM file(s)"); L(" -w, --wam-for-byte-code stop after producing WAM for byte-code file(s) (force --no-call-c)"); L(" -M, --mini-assembly stop after producing mini-assembly file(s)"); L(" -S, --assembly stop after producing assembly file(s)"); L(" -F, --fd-to-c stop after producing C file(s) from FD file(s)"); L(" -c, --object stop after producing object file(s)"); L(" --temp-dir PATH use PATH as directory for temporary files"); L(" --no-del-temp-files do not delete temporary files"); L(" --no-demangling do not decode hexadecimal predicate names"); L(" --no-decode-hexa same as --no-demanling (deprecated)"); L(" -v, --verbose print executed commands"); L(" -h, --help print this help and exit"); L(" --version print version number and exit"); L(" "); L("Prolog to WAM compiler options:"); L(" --pl-state FILE read FILE to set the initial Prolog state"); L(" --wam-comment COMMENT emit COMMENT as a comment in the WAM file"); L(" --no-susp-warn do not show warnings for suspicious predicates"); L(" --no-singl-warn do not show warnings for named singleton variables"); L(" --no-redef-error do not show errors for built-in redefinitions"); L(" --foreign-only only compile foreign/1-2 directives"); L(" --no-call-c do not allow the use of fd_tell, '$call_c',..."); L(" --no-inline do not inline predicates"); L(" --no-reorder do not reorder predicate arguments"); L(" --no-reg-opt do not optimize registers"); L(" --min-reg-opt minimally optimize registers"); L(" --no-opt-last-subterm do not optimize last subterm compilation"); L(" --fast-math fast mathematical mode (assume integer arithmetics)"); L(" --keep-void-inst keep void instructions in the output file"); L(" --compile-msg print a compile message"); L(" --statistics print statistics information"); L(" "); L("WAM to mini-assembly translator options:"); L(" --comment include comments in the output file"); L(" "); L("Mini-assembly to assembly translator options:"); L(" --comment include comments in the output file"); L(" --pic produce position independent code (PIC)"); L(" --inline-asm inline some C calls as asm instructions"); L(" --full-inline-asm inline most C calls as asm instructions"); L(" "); L("C Compiler options:"); L(" --c-compiler FILE use FILE as C compiler/linker"); L(" -C OPTION pass OPTION to the C compiler"); L(" "); L("Assembler options:"); L(" -A OPTION pass OPTION to the assembler"); L(" "); L("Linker options:"); L(" --linker FILE use FILE as linker"); L(" --local-size N set default local stack size to N Kb"); L(" --global-size N set default global stack size to N Kb"); L(" --trail-size N set default trail stack size to N Kb"); L(" --cstr-size N set default cstr stack size to N Kb"); L(" --max-atom N set default atom table size to N atoms"); L(" --fixed-sizes do not consult environment variables at run-time"); L(" --gui-console link the Win32 GUI console"); L(" --no-top-level do not link the top-level (force --no-debugger)"); L(" --no-debugger do not link the Prolog/WAM debugger"); L(" --min-pl-bips link only used Prolog built-in predicates"); L(" --min-fd-bips link only used FD solver built-in predicates"); L(" --min-bips same as: --no-top-level --min-pl-bips --min-fd-bips --no-debugger"); L(" --min-size same as: --min-bips --strip"); L(" --no-pl-lib do not look for the Prolog and FD libraries (maintenance only)"); L(" --no-fd-lib do not look for the FD library (maintenance only)"); L(" --no-fd-lib-warn do not warn about inexistent FD library (maintenance only)"); L(" -s, --strip strip the executable"); L(" -L OPTION pass OPTION to the linker"); L(""); L("The file name specified after --output can include meta-characters:"); L(" %f for the whole input file name, %F same as %f without directory"); L(" %p for the whole prefix name, %P same as %p without directory"); L(" %s for the suffix (or empty if not specified)"); L(" %d for the directory part (or empty if not specified)"); L(" %c for a auto-increment counter"); L(""); L("Report bugs to bug-prolog@gnu.org."); } #undef L ������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/Makefile.in���������������������������������������������������������������0000644�0001750�0001750�00000002160�13021324543�015533� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TOP_LEVEL = @TOP_LEVEL@ TOP_LEVEL_FLAGS = @TOP_LEVEL_FLAGS@ GPLC = @GPLC@ CFLAGS = @CFLAGS@ HEXGPLC = @HEXGPLC@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ LDLIBS = @LDLIBS@ EXECS = $(GPLC)@EXE_SUFFIX@ $(HEXGPLC)@EXE_SUFFIX@ ALL_EXECS = $(EXECS) $(TOP_LEVEL)@EXE_SUFFIX@ first: $(EXECS) $(GPLC)@EXE_SUFFIX@: top_comp.c copying.c ../EnginePl/wam_regs.h \ ../EnginePl/gp_config.h ../EnginePl/machine1.c decode_hexa.c copying.c prolog_path.c $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@$(GPLC)@EXE_SUFFIX@ top_comp.c $(LDLIBS) $(HEXGPLC)@EXE_SUFFIX@: hexfilter.c decode_hexa.c $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@$(HEXGPLC)@EXE_SUFFIX@ hexfilter.c all: $(ALL_EXECS) top-level: $(TOP_LEVEL)@EXE_SUFFIX@ $(TOP_LEVEL)@EXE_SUFFIX@: ../EnginePl/gp_config.h copying.c top_level.c $(GPLC) $(TOP_LEVEL_FLAGS) -o $(TOP_LEVEL)@EXE_SUFFIX@ -C '$(CFLAGS)' top_level.c clean: -mv $(TOP_LEVEL)@EXE_SUFFIX@ $(TOP_LEVEL)0@EXE_SUFFIX@ rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp $(ALL_EXECS) distclean: rm -f *@OBJ_SUFFIX@ $(ALL_EXECS) $(TOP_LEVEL)0@EXE_SUFFIX@ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/TopComp/decode_hexa.c�������������������������������������������������������������0000644�0001750�0001750�00000042601�13021324543�016066� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog Compiler * * File : decode_hexa.c * * Descr.: hexadecimal decoding * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #include <ctype.h> /* This file is included by top_comp.c, hexfilter.c and wam2ma.c */ /* Name Mangling (decoration). * * A [MODULE:]PRED/N will be encoded as * * XK_[E(MODULE)__]E(PRED)__aN * * K: an ASCII digit '0'-'5' storing coding information about MODULE and PRED * associated integer (value on 3 bits): * 0 (00 0) : no module present PRED is not encoded * 1 (00 1) : no module present PRED is encoded * 2 (01 0) : MODULE is not encoded PRED is not encoded * 3 (01 1) : MODULE is not encoded PRED is encoded * 4 (10 0) : MODULE is encoded PRED is not encoded * 5 (10 1) : MODULE is encoded PRED is encoded * * Where E(STR) = * - STR (not encoded) if STR only contains letters, digits or _ * but does not contain the substring __ and does not begin/end with _ * regexp: [a-zA-Z0-9] ([-]?[a-zA-Z0-9])* * - an hexa representation (encoded) of each character of the string * * NB: if this mangling schema is modified also modify macro * Prolog_Prototype in engine.h */ static char pl_escape_symbol[] = "abfnrtv"; static char pl_escape_char[] = "\a\b\f\n\r\t\v"; #define AUX_STR "_$aux" /* for encoding: we do not use isalpha to avoid problems with localization * an accent-letter is not a valid C/asm identifier */ #define Letter(c) (((c) >= 'a' && (c) <= 'z') || ((c) >= 'A' && (c) <= 'Z')) #define Letter_Digit(c) (Letter(c) || isdigit(c)) #define Hexa_Digit(c) (isdigit(c) || ((c) >= 'A' && (c) <= 'F')) #define Hex_Num(c) (isdigit(c) ? (c) - '0' : (c) - 'A' + 10) static int String_Needs_Encoding(char *str); static char *Encode_String(char *str, char *buff); static char *Copy_Not_Encoded_String(char *str, char *buff); static char *Decode_String(char *str, char *buff); static void Quote_If_Needed(char *str); static char *Parse_Atom(char *src, char *dst); /*-------------------------------------------------------------------------* * ENCODE_HEXA * * * * module : the module to encode (NULL or '\0' if no module qualif) * * pred : the predicate functor * * arity : the arity (or -1 if no arity present) * * str : the resulting encoded string * * * * Returns the next position in str * *-------------------------------------------------------------------------*/ char * Encode_Hexa(char *module, char *pred, int arity, char *str) { int module_encode = (module == NULL || *module == '\0') ? 0 : String_Needs_Encoding(module) + 1; int pred_encode = String_Needs_Encoding(pred); *str++ = 'X'; *str++ = '0' + ((module_encode << 1) | pred_encode); *str++ = '_'; if (module_encode == 1) str += sprintf(str, "%s__", module); else if (module_encode == 2) { str = Encode_String(module, str); *str++ = '_'; *str++ = '_'; } if (pred_encode == 0) str += sprintf(str, "%s", pred); else str = Encode_String(pred, str); if (arity >= 0) str += sprintf(str, "__a%d", arity); return str; } /*-------------------------------------------------------------------------* * ENCODE_HEXA_LINE * * * * str : the line to encode * * format : printf format to emit encoded strings (or NULL) * * strict : 1: only predicate indicators, 0: also predicate names * * * * Returns an encoded line (static buffer) * *-------------------------------------------------------------------------*/ char * Encode_Hexa_Line(char *str, char *format, int strict) { static char result[4096]; static char buff[4096]; char *module, *pred; char *src, *dst; char *p, *q, *free_in_buff; int arity; if (format == NULL) format = "%s"; src = str; dst = result; for(;;) { while(isspace(*src)) *dst++ = *src++; if (*src == '\0') break; p = Parse_Atom(src, buff); if (p == NULL) { *dst++ = *src++; continue; } if (*p == ':') /* module qualif found */ { module = buff; pred = buff + strlen(module) + 1; q = p + 1; p = Parse_Atom(q, pred); if (p == NULL) { while(src < q) *dst++ = *src++; continue; } } else { module = NULL; pred = buff; } arity = strtol(p + 1, &q, 10); /* we suppose *p = '/' */ if (*pred == '\0' || (*p != '/' && strict) || (*p == '/' && (arity < 0 || arity > 1024 || isalnum(*q) || *q == '_'))) { while(src < q) *dst++ = *src++; continue; } if (*p != '/') { arity = -1; src = p; } else src = q; free_in_buff = pred + strlen(pred) + 1; Encode_Hexa(module, pred, arity, free_in_buff); dst += sprintf(dst, format, free_in_buff); } *dst++ = '\0'; return result; } /*-------------------------------------------------------------------------* * STRING_NEEDS_ENCODING * * * *-------------------------------------------------------------------------*/ static int String_Needs_Encoding(char *str) { if (*str == '\0' || !Letter_Digit(*str)) return 1; while(*++str != '\0') { if (*str == '_') { if (str[-1] == '_' || str[1] == '\0') return 1; } else { if (!Letter_Digit(*str)) return 1; } } return 0; } /*-------------------------------------------------------------------------* * ENCODE_STRING * * * *-------------------------------------------------------------------------*/ static char * Encode_String(char *str, char *buff) { while(*str) { sprintf(buff, "%02X", (unsigned) (unsigned char) *str); str++; buff += 2; } return buff; } /*-------------------------------------------------------------------------* * DECODE_HEXA * * * * str : the string to decode * * strict : 1: only predicate indicators, 0: also predicate names * * quote : 0: no quotes, 1: surround module|pred with quotes if needed * * decode_aux: 0: no, 1: as its father, 2: as father + auxiliary number * * module : the resulting decoded module ('\0' if no module qualif) * * pred : the resulting predicate functor * * arity : the resulting arity (or -1 if no arity present and !strict) * * aux_no : the resulting aux no (if decode_aux != 0) or -1 * * * * Returns NULL if str is not well encoded or the next position in str * *-------------------------------------------------------------------------*/ char * Decode_Hexa(char *str, int strict, int quote, int decode_aux, char *module, char *pred, int *arity, int *aux_no) { int n; int module_encode; int pred_encode; char *p, *q; if (*str++ != 'X' || *str < '0' || *str >= '5') return NULL; n = *str++ - '0'; module_encode = n >> 1; pred_encode = n & 1; if (*str++ != '_') return NULL; if (module_encode == 0) /* no module qualif */ *module = '\0'; else { str = (module_encode == 1) ? Copy_Not_Encoded_String(str, module) : Decode_String(str, module); if (str == NULL || *str++ != '_' || *str++ != '_') return NULL; if (quote) Quote_If_Needed(module); } str = (pred_encode == 0) ? Copy_Not_Encoded_String(str, pred) : Decode_String(str, pred); if (str == NULL || *pred == '\0') return NULL; *arity = -1; if (*str == '_' && str[1] == '_' && str[2] == 'a') /* the arity */ { *arity = strtoul(str + 3, &p, 10); /* +3 to skip '__a' */ if (p == str + 3) *arity = -1; str = p; } if (*arity < 0 || *arity > 1024 || isalnum(*p) || *p == '_') /* no valid arity found */ { if (strict) return NULL; *arity = -1; } *aux_no = -1; if (decode_aux && *pred == '$' && (p = strstr(pred, AUX_STR)) != NULL) { n = strtol(p + sizeof(AUX_STR) - 1, &q, 10); if (*q == '\0') { while(--p > pred && isdigit(*p)) /* search for arity of the father pred */ ; if (p >= pred && *p == '/') /* father arity found */ { *aux_no = n; *p = '\0'; *arity = strtol(p + 1, &p, 10); p = pred; do *p = p[1]; while(*p++); /* skip leading $ */ } } } if (quote) Quote_If_Needed(pred); return str; } /*-------------------------------------------------------------------------* * DECODE_HEXA_LINE * * * * str : the line to decode * * format : printf format to emit decoded strings (or NULL) * * strict : 1: only predicate indicators, 0: also predicate names * * quote : 0: no quotes, 1: surround module|pred with quotes if needed * * decode_aux: 0: no, 1: as its father, 2: as father + auxiliary number * * * * Returns a decoded line (static buffer) * *-------------------------------------------------------------------------*/ char * Decode_Hexa_Line(char *str, char *format, int strict, int quote, int decode_aux) { static char result[4096]; static char module[2048]; static char pred[1024]; int arity; int aux_no; char *src, *dst, *p; int n; if (format == NULL) format = "%s"; src = str; dst = result; while(*src) { p = src; if ((*src == 'X' || (*src == '_' && *(p = src + 1) == 'X')) && (src == str || !isalnum(src[-1])) && ((p = Decode_Hexa(p, strict, quote, decode_aux, module, pred, &arity, &aux_no)) != NULL)) { src = p; n = strlen(module); if (n) module[n++] = ':'; n += sprintf(module + n, "%s", pred); if (arity >= 0) n += sprintf(module + n, "/%d", arity); if (decode_aux == 2 && aux_no >= 0) n += sprintf(module + n, "(aux %d)", aux_no); dst += sprintf(dst, format, module); } else *dst++ = *src++; } *dst = '\0'; return result; } /*-------------------------------------------------------------------------* * COPY_NOT_ENCODED_STRING * * * *-------------------------------------------------------------------------*/ static char * Copy_Not_Encoded_String(char *str, char *buff) { if (!Letter_Digit(*str)) return NULL; *buff++ = *str++; while(*str != '\0') { if (*str == '_') { if (str[-1] == '_' || str[1] == '\0') { str--; buff--; break; } } else { if (!Letter_Digit(*str)) break; } *buff++ = *str++; } *buff = '\0'; return str; } /*-------------------------------------------------------------------------* * DECODE_STRING * * * *-------------------------------------------------------------------------*/ static char * Decode_String(char *str, char *buff) { while(Hexa_Digit(*str) && Hexa_Digit(str[1])) { *buff++ = Hex_Num(*str) * 16 + Hex_Num(str[1]); str += 2; } *buff = '\0'; return str; } /*-------------------------------------------------------------------------* * QUOTE_IF_NEEDED * * * *-------------------------------------------------------------------------*/ static void Quote_If_Needed(char *str) { static char buff[2048]; char *p; char *q, *r; if (islower(*str)) { for(p = str; isalnum(*p) || *p == '_'; p++) ; if (*p == '\0') return; } p = str; q = buff; *q++ = '\''; for(p = str; *p; p++) { if ((r = (char *) strchr(pl_escape_char, *p))) { *q++ = '\\'; *q++ = pl_escape_symbol[r - pl_escape_char]; } else if (*p == '\'' || *p == '\\') /* display twice */ { *q++ = *p; *q++ = *p; } else if (!isprint(*p)) { q += sprintf(q, "\\x%x\\", (unsigned) (unsigned char) *p); } else *q++ = *p; } *q++ = '\''; *q = '\0'; strcpy(str, buff); } /*-------------------------------------------------------------------------* * PARSE_ATOM * * * *-------------------------------------------------------------------------*/ static char * Parse_Atom(char *src, char *dst) { char *p; int i; char delim; if (*src == '\'' || *src == '"') /* quoted atom (we also accept double quotes") */ { delim = *src++; while (*src && (*src != delim || src[1] == delim)) { if (*src == delim) { *dst++ = delim; src += 2; continue; } if (*src == '\\') { src++; if (strchr("\\'\"`", *src)) /* \\ or \' or \" or \` */ { *dst++ = *src++; continue; } if ((p = (char *) strchr(pl_escape_symbol, *src))) /* \a \b \f \n \r \t \v */ { *dst++ = pl_escape_char[p - pl_escape_symbol]; continue; } if (*src == 'x') { src++; i = 16; } else i = 8; i = strtol(src, &p, i); /* stop on the closing \ */ if (p == src || !isxdigit(*src) || *p != '\\') /* isxdigit test is for sign */ return NULL; *dst++ = (char) i; src = p + 1; } else *dst++ = *src++; /* normal char */ } if (*src != delim) return NULL; src++; } else { if (!isalpha(*src) && *src != '_' && *src != '$') return NULL; while (isalnum(*src) || *src == '_' || *src == '$') { *dst++ = *src++; } } *dst = '\0'; return src; } �������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/SETVARS���������������������������������������������������������������������������0000644�0001750�0001750�00000000217�13021324543�013160� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������a=`pwd` PATH=$a/TopComp:$a/EnginePl:$a/Pl2Wam:$a/Wam2Ma:$a/Ma2Asm:$a/Fd2C:$a/DevUtils:$a/W32GUICons:$PATH:/usr/ucb/:/usr/ccs/bin/ export PATH ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/���������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013303� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/b_params.h�����������������������������������������������������������������0000644�0001750�0001750�00000006212�13021324543�015235� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : b_params.h * * Descr.: parameter header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define MAX_VAR_NAME_LENGTH 1024 #define MAX_VAR_IN_TERM 32768 #define MAX_SYS_VARS 256 /* to return an hash as a Tagged INT use a modulo with HASH_MOD_VALUE * it is the 1+max_integer on 32 bits */ #define HASH_MOD_VALUE (1 << (32 - TAG_SIZE - 1)) /* ISO DTC2 seems to allow layout chars between minus sign and the number */ #if 1 #define MINUS_SIGN_CAN_BE_FOLLOWED_BY_SPACES #endif ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/os_interf_c.c��������������������������������������������������������������0000644�0001750�0001750�00000116771�13021324543�015752� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : os_interf_c.c * * Descr.: operating system interface management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <math.h> #include <string.h> #include <errno.h> #include <signal.h> #include <time.h> #include <sys/stat.h> #include <sys/types.h> #include "gp_config.h" #ifdef _WIN32 #include <process.h> #include <direct.h> #include <io.h> #include <winsock.h> #include <fcntl.h> #else #define _XOPEN_SOURCE_EXTENDED /* for alpha/OSF (usleep prototype) */ #include <dirent.h> #include <unistd.h> #include <sys/param.h> #include <sys/time.h> #include <sys/wait.h> #endif #define OBJ_INIT Os_Interf_Initializer #include "engine_pl.h" #include "bips_pl.h" #if 0 #define DEBUG #endif /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_SIGNALS 255 #define MAX_SPAWN_ARGS 1024 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int atom; int sig; } InfSig; /*---------------------------------* * Global Variables * *---------------------------------*/ static int atom_dt; /* pl_atom_write is already defined in the set of often used atoms */ static int atom_execute; static int atom_search; static int atom_regular; static int atom_directory; static int atom_fifo; static int atom_socket; static int atom_character_device; static int atom_block_device; static int atom_unknown; static InfSig tsig[MAX_SIGNALS]; static int nb_sig; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int Flag_Of_Permission(WamWord perm_word, Bool is_a_directory); static char *Get_Path_Name(WamWord path_name_word); static Bool Date_Time_To_Prolog(time_t *t, WamWord date_time_word); static int Select_Init_Set(WamWord list_word, fd_set *set, int check); static Bool Select_Init_Ready_List(WamWord list_word, fd_set *set, WamWord ready_list_word); /*-------------------------------------------------------------------------* * OS_INTERF_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Os_Interf_Initializer(void) { atom_dt = Pl_Create_Atom("dt"); atom_execute = Pl_Create_Atom("execute"); atom_search = Pl_Create_Atom("search"); atom_regular = Pl_Create_Atom("regular"); atom_directory = Pl_Create_Atom("directory"); atom_fifo = Pl_Create_Atom("fifo"); atom_socket = Pl_Create_Atom("socket"); atom_character_device = Pl_Create_Atom("character_device"); atom_block_device = Pl_Create_Atom("block_device"); atom_unknown = Pl_Create_Atom("unknown"); nb_sig = 0; #if defined(__unix__) || defined(__CYGWIN__) tsig[nb_sig].atom = Pl_Create_Atom("SIGHUP"); tsig[nb_sig++].sig = SIGHUP; tsig[nb_sig].atom = Pl_Create_Atom("SIGINT"); tsig[nb_sig++].sig = SIGINT; tsig[nb_sig].atom = Pl_Create_Atom("SIGQUIT"); tsig[nb_sig++].sig = SIGQUIT; tsig[nb_sig].atom = Pl_Create_Atom("SIGILL"); tsig[nb_sig++].sig = SIGILL; tsig[nb_sig].atom = Pl_Create_Atom("SIGTRAP"); tsig[nb_sig++].sig = SIGTRAP; tsig[nb_sig].atom = Pl_Create_Atom("SIGABRT"); tsig[nb_sig++].sig = SIGABRT; #ifndef M_ix86_cygwin tsig[nb_sig].atom = Pl_Create_Atom("SIGIOT"); tsig[nb_sig++].sig = SIGIOT; #endif tsig[nb_sig].atom = Pl_Create_Atom("SIGBUS"); tsig[nb_sig++].sig = SIGBUS; tsig[nb_sig].atom = Pl_Create_Atom("SIGFPE"); tsig[nb_sig++].sig = SIGFPE; tsig[nb_sig].atom = Pl_Create_Atom("SIGKILL"); tsig[nb_sig++].sig = SIGKILL; tsig[nb_sig].atom = Pl_Create_Atom("SIGUSR1"); tsig[nb_sig++].sig = SIGUSR1; tsig[nb_sig].atom = Pl_Create_Atom("SIGSEGV"); tsig[nb_sig++].sig = SIGSEGV; tsig[nb_sig].atom = Pl_Create_Atom("SIGUSR2"); tsig[nb_sig++].sig = SIGUSR2; tsig[nb_sig].atom = Pl_Create_Atom("SIGPIPE"); tsig[nb_sig++].sig = SIGPIPE; tsig[nb_sig].atom = Pl_Create_Atom("SIGALRM"); tsig[nb_sig++].sig = SIGALRM; tsig[nb_sig].atom = Pl_Create_Atom("SIGTERM"); tsig[nb_sig++].sig = SIGTERM; tsig[nb_sig].atom = Pl_Create_Atom("SIGCHLD"); tsig[nb_sig++].sig = SIGCHLD; tsig[nb_sig].atom = Pl_Create_Atom("SIGCONT"); tsig[nb_sig++].sig = SIGCONT; tsig[nb_sig].atom = Pl_Create_Atom("SIGSTOP"); tsig[nb_sig++].sig = SIGSTOP; tsig[nb_sig].atom = Pl_Create_Atom("SIGTSTP"); tsig[nb_sig++].sig = SIGTSTP; tsig[nb_sig].atom = Pl_Create_Atom("SIGTTIN"); tsig[nb_sig++].sig = SIGTTIN; tsig[nb_sig].atom = Pl_Create_Atom("SIGTTOU"); tsig[nb_sig++].sig = SIGTTOU; tsig[nb_sig].atom = Pl_Create_Atom("SIGURG"); tsig[nb_sig++].sig = SIGURG; tsig[nb_sig].atom = Pl_Create_Atom("SIGXCPU"); tsig[nb_sig++].sig = SIGXCPU; tsig[nb_sig].atom = Pl_Create_Atom("SIGXFSZ"); tsig[nb_sig++].sig = SIGXFSZ; tsig[nb_sig].atom = Pl_Create_Atom("SIGVTALRM"); tsig[nb_sig++].sig = SIGVTALRM; tsig[nb_sig].atom = Pl_Create_Atom("SIGPROF"); tsig[nb_sig++].sig = SIGPROF; tsig[nb_sig].atom = Pl_Create_Atom("SIGWINCH"); tsig[nb_sig++].sig = SIGWINCH; #ifndef M_ix86_sco tsig[nb_sig].atom = Pl_Create_Atom("SIGIO"); tsig[nb_sig++].sig = SIGIO; #endif #if !defined(M_bsd) && !defined(M_darwin) tsig[nb_sig].atom = Pl_Create_Atom("SIGPOLL"); tsig[nb_sig++].sig = SIGPOLL; #endif #endif #if defined(__unix__) || defined(__CYGWIN__) signal(SIGPIPE, SIG_IGN); #endif } /*-------------------------------------------------------------------------* * PL_MAKE_DIRECTORY_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Make_Directory_1(WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); #ifdef _WIN32 Os_Test_Error(_mkdir(path_name)); #else Os_Test_Error(mkdir(path_name, 0777)); #endif return TRUE; } /*-------------------------------------------------------------------------* * PL_DELETE_DIRECTORY_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Delete_Directory_1(WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); Os_Test_Error(rmdir(path_name)); return TRUE; } /*-------------------------------------------------------------------------* * PL_WORKING_DIRECTORY_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Working_Directory_1(WamWord path_name_word) { char *path_name; path_name = Pl_M_Get_Working_Dir(); return Pl_Un_String_Check(path_name, path_name_word); } /*-------------------------------------------------------------------------* * PL_CHANGE_DIRECTORY_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Change_Directory_1(WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); errno = -1; if (!Pl_M_Set_Working_Dir(path_name)) Os_Test_Error(-1); return TRUE; } /*-------------------------------------------------------------------------* * PL_DIRECTORY_FILES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Directory_Files_2(WamWord path_name_word, WamWord list_word) { char *path_name; Bool res; char *name; #ifdef _WIN32 PlLong h; struct _finddata_t d; static char buff[MAXPATHLEN]; #else DIR *dir; struct dirent *cur_entry; #endif Pl_Check_For_Un_List(list_word); path_name = Get_Path_Name(path_name_word); #ifdef _WIN32 sprintf(buff, "%s\\*.*", path_name); h = _findfirst(buff, &d); /* instead of Win32 FindFirstFile since uses errno */ Os_Test_Error(h); #else dir = opendir(path_name); Os_Test_Error_Null(dir); #endif #ifdef _WIN32 do { name = d.name; #else while ((cur_entry = readdir(dir)) != NULL) { name = cur_entry->d_name; #endif if (!Pl_Get_List(list_word) || !Pl_Unify_Atom(Pl_Create_Allocate_Atom(name))) { res = FALSE; goto finish; } list_word = Pl_Unify_Variable(); } #ifdef _WIN32 while (_findnext(h, &d) == 0); #endif res = Pl_Get_Nil(list_word); finish: #ifdef _WIN32 _findclose(h); #else closedir(dir); #endif return res; } /*-------------------------------------------------------------------------* * PL_RENAME_FILE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Rename_File_2(WamWord path_name1_word, WamWord path_name2_word) { char path_name1[MAXPATHLEN]; char *path_name2; strcpy(path_name1, Get_Path_Name(path_name1_word)); path_name2 = Get_Path_Name(path_name2_word); Os_Test_Error(rename(path_name1, path_name2)); return TRUE; } /*-------------------------------------------------------------------------* * PL_UNLINK_1 * * * *-------------------------------------------------------------------------*/ void Pl_Unlink_1(WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); unlink(path_name); } /*-------------------------------------------------------------------------* * PL_DELETE_FILE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Delete_File_1(WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); Os_Test_Error(unlink(path_name)); return TRUE; } /*-------------------------------------------------------------------------* * PL_FILE_EXISTS_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Exists_1(WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); if (access(path_name, F_OK)) { if (errno == ENOENT || errno == ENOTDIR) return FALSE; Os_Test_Error(-1); } return TRUE; } /*-------------------------------------------------------------------------* * PL_FILE_PERMISSION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Permission_2(WamWord path_name_word, WamWord perm_list_word) { WamWord word, tag_mask; WamWord save_perm_list_word; WamWord *lst_adr; char *path_name; int mode, perm = 0; struct stat file_info; int res; Bool is_a_directory; path_name = Get_Path_Name(path_name_word); res = stat(path_name, &file_info); if (res == -1 && errno != ENOENT && errno != ENOTDIR) Os_Test_Error(-1); mode = file_info.st_mode; is_a_directory = (res == 0) && S_ISDIR(mode); DEREF(perm_list_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK && word != NIL_WORD) perm |= Flag_Of_Permission(word, is_a_directory); else { save_perm_list_word = perm_list_word; for (;;) { DEREF(perm_list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_perm_list_word); lst_adr = UnTag_LST(word); perm |= Flag_Of_Permission(Car(lst_adr), is_a_directory); perm_list_word = Cdr(lst_adr); } } return (res == 0) && perm > 0 && ((mode | perm) == mode); } /*-------------------------------------------------------------------------* * FLAG_OF_PERMISSION * * * *-------------------------------------------------------------------------*/ static int Flag_Of_Permission(WamWord perm_word, Bool is_a_directory) { int atom; atom = Pl_Rd_Atom_Check(perm_word); if (atom == pl_atom_read) return S_IRUSR; if (atom == pl_atom_write) return S_IWUSR; if (atom == atom_execute) return (is_a_directory) ? -1 : S_IXUSR; if (atom == atom_search) return (is_a_directory) ? S_IXUSR : -1; Pl_Err_Domain(pl_domain_os_file_permission, perm_word); return 0; /* anything for the compiler */ } /*-------------------------------------------------------------------------* * PL_FILE_PROP_ABSOLUTE_FILE_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Prop_Absolute_File_Name_2(WamWord absolute_path_name_word, WamWord path_name_word) { char *path_name; path_name = Get_Path_Name(path_name_word); Os_Test_Error(access(path_name, F_OK)); /* test if file exists */ return Pl_Un_String_Check(path_name, absolute_path_name_word); } /*-------------------------------------------------------------------------* * PL_FILE_PROP_REAL_FILE_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Prop_Real_File_Name_2(WamWord real_path_name_word, WamWord path_name_word) { char *path_name = Get_Path_Name(path_name_word); #ifndef _WIN32 char real_path_name[MAXPATHLEN]; Os_Test_Error_Null(realpath(path_name, real_path_name)); #else char *real_path_name = path_name; #endif return Pl_Un_String_Check(real_path_name, real_path_name_word); } /*-------------------------------------------------------------------------* * PL_FILE_PROP_TYPE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Prop_Type_2(WamWord type_word, WamWord path_name_word) { char *path_name; struct stat file_info; int atom; path_name = Get_Path_Name(path_name_word); Os_Test_Error(stat(path_name, &file_info)); if (S_ISREG(file_info.st_mode)) atom = atom_regular; else if (S_ISDIR(file_info.st_mode)) atom = atom_directory; #ifdef S_ISFIFO else if (S_ISFIFO(file_info.st_mode)) atom = atom_fifo; #endif #ifdef S_ISSOCK else if (S_ISSOCK(file_info.st_mode)) atom = atom_socket; #endif #ifdef S_ISCHR else if (S_ISCHR(file_info.st_mode)) atom = atom_character_device; #endif #ifdef S_ISBLK else if (S_ISBLK(file_info.st_mode)) atom = atom_block_device; #endif else atom = atom_unknown; return Pl_Un_Atom_Check(atom, type_word); } /*-------------------------------------------------------------------------* * PL_FILE_PROP_SIZE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Prop_Size_2(WamWord size_word, WamWord path_name_word) { char *path_name; struct stat file_info; path_name = Get_Path_Name(path_name_word); Os_Test_Error(stat(path_name, &file_info)); return Pl_Un_Positive_Check((int) file_info.st_size, size_word); } /*-------------------------------------------------------------------------* * PL_CHECK_PROP_PERM_AND_FILE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Check_Prop_Perm_And_File_2(WamWord perm_word, WamWord path_name_word) { WamWord word, tag_mask; char *path_name; path_name = Get_Path_Name(path_name_word); DEREF(perm_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) Flag_Of_Permission(perm_word, FALSE); /* to check perm validity */ Os_Test_Error(access(path_name, F_OK)); /* to check file existence */ return TRUE; } /*-------------------------------------------------------------------------* * PL_FILE_PROP_DATE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_File_Prop_Date_2(WamWord date_time_word, WamWord path_name_word) { char *path_name; struct stat file_info; time_t *t; path_name = Get_Path_Name(path_name_word); Os_Test_Error(stat(path_name, &file_info)); switch (pl_sys_var[0]) { case 0: t = &(file_info.st_ctime); break; case 1: t = &(file_info.st_atime); break; default: t = &(file_info.st_mtime); break; } return Date_Time_To_Prolog(t, date_time_word); } /*-------------------------------------------------------------------------* * PL_TEMPORARY_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Temporary_Name_2(WamWord template_word, WamWord path_name_word) { char *template; char *path_name; template = Get_Path_Name(template_word); path_name = Pl_M_Mktemp(template); Os_Test_Error_Null(path_name); return path_name && Pl_Un_String_Check(path_name, path_name_word); } /*-------------------------------------------------------------------------* * PL_TEMPORARY_FILE_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Temporary_File_3(WamWord dir_word, WamWord prefix_word, WamWord path_name_word) { char *dir; char *prefix; char *path_name; dir = Pl_Rd_String_Check(dir_word); if (*dir == '\0') dir = NULL; else dir = Get_Path_Name(dir_word); prefix = Pl_Rd_String_Check(prefix_word); if (*prefix == '\0') prefix = NULL; path_name = Pl_M_Tempnam(dir, prefix); Os_Test_Error_Null(path_name); return path_name && Pl_Un_String_Check(path_name, path_name_word); } /*-------------------------------------------------------------------------* * PL_DATE_TIME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Date_Time_1(WamWord date_time_word) { time_t t; t = time(NULL); return Date_Time_To_Prolog(&t, date_time_word); } /*-------------------------------------------------------------------------* * PL_HOST_NAME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Host_Name_1(WamWord host_name_word) { WamWord word, tag_mask; int atom; static int atom_host_name = -1; /* not created in an init since */ /* establishes a connection */ /* (ifndef NO_USE_SOCKETS) */ if (atom_host_name < 0) atom_host_name = Pl_Create_Allocate_Atom(Pl_M_Host_Name_From_Name(NULL)); DEREF(host_name_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) return Pl_Get_Atom(atom_host_name, host_name_word); atom = Pl_Rd_Atom_Check(word); return atom == atom_host_name || strcmp(Pl_M_Host_Name_From_Name(pl_atom_tbl[atom].name), pl_atom_tbl[atom_host_name].name) == 0; } /*-------------------------------------------------------------------------* * PL_OS_VERSION_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Os_Version_1(WamWord os_version_word) { return Pl_Un_String_Check(pl_m_os_version, os_version_word); } /*-------------------------------------------------------------------------* * PL_ARCHITECTURE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Architecture_1(WamWord architecture_word) { return Pl_Un_String_Check(pl_m_architecture, architecture_word); } /*-------------------------------------------------------------------------* * PL_SLEEP_1 * * * *-------------------------------------------------------------------------*/ void Pl_Sleep_1(WamWord seconds_word) { #ifdef _WIN32 DWORD ms; ms = (DWORD) (Pl_Rd_Number_Check(seconds_word) * 1000); if (ms < 0) Pl_Err_Domain(pl_domain_not_less_than_zero, seconds_word); Sleep(ms); #else PlLong us; us = (PlLong) (Pl_Rd_Number_Check(seconds_word) * 1000000); if (us < 0) Pl_Err_Domain(pl_domain_not_less_than_zero, seconds_word); usleep(us); #endif } /*-------------------------------------------------------------------------* * PL_SHELL_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Shell_2(WamWord cmd_word, WamWord status_word) { char *cmd; int status; cmd = Pl_Rd_String_Check(cmd_word); if (*cmd == '\0') cmd = NULL; Pl_Check_For_Un_Integer(status_word); Pl_Flush_All_Streams(); status = Pl_M_Shell(cmd); return Pl_Get_Integer(status, status_word); } /*-------------------------------------------------------------------------* * PL_SYSTEM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_System_2(WamWord cmd_word, WamWord status_word) { char *cmd; int status; cmd = Pl_Rd_String_Check(cmd_word); Pl_Check_For_Un_Integer(status_word); #ifdef _WIN32 _flushall(); #endif Pl_Flush_All_Streams(); status = system(cmd); return Pl_Get_Integer(status, status_word); } /*-------------------------------------------------------------------------* * PL_SPAWN_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Spawn_3(WamWord cmd_word, WamWord list_word, WamWord status_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; char *arg[MAX_SPAWN_ARGS]; char **p = arg; char err[64]; int status; save_list_word = list_word; *p++ = Pl_Rd_String_Check(cmd_word); for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); *p++ = Pl_Rd_String_Check(Car(lst_adr)); list_word = Cdr(lst_adr); } *p = NULL; Pl_Check_For_Un_Integer(status_word); Pl_Flush_All_Streams(); status = Pl_M_Spawn(arg); if (status == -1) Os_Test_Error(status); else if (status == -2) { sprintf(err, "error trying to execute %s", arg[0]); Pl_Err_System(Pl_Create_Allocate_Atom(err)); return FALSE; } return Pl_Get_Integer(status, status_word); } /*-------------------------------------------------------------------------* * PL_POPEN_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Popen_3(WamWord cmd_word, WamWord mode_word, WamWord stm_word) { char *cmd; int atom; int mode; int stm; FILE *f; char open_str[10]; cmd = Pl_Rd_String_Check(cmd_word); atom = Pl_Rd_Atom_Check(mode_word); if (atom == pl_atom_read) { mode = STREAM_MODE_READ; strcpy(open_str, "r"); } else if (atom == pl_atom_write) { mode = STREAM_MODE_WRITE; strcpy(open_str, "w"); } else Pl_Err_Domain(pl_domain_io_mode, mode_word); Pl_Flush_All_Streams(); f = popen(cmd, open_str); Os_Test_Error_Null(f); sprintf(pl_glob_buff, "popen_stream('%.1024s')", cmd); atom = Pl_Create_Allocate_Atom(pl_glob_buff); stm = Pl_Add_Stream_For_Stdio_Desc(f, atom, mode, TRUE); pl_stm_tbl[stm]->fct_close = (StmFct) pclose; return Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_EXEC_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Exec_5(WamWord cmd_word, WamWord stm_in_word, WamWord stm_out_word, WamWord stm_err_word, WamWord pid_word) { char *cmd; char **arg; int stm; FILE *f_in, *f_out, *f_err; int pid; int mask = SYS_VAR_OPTION_MASK; int atom; char err[1024]; cmd = Pl_Rd_String_Check(cmd_word); arg = Pl_M_Create_Shell_Command(cmd); Pl_Flush_All_Streams(); pid = Pl_M_Spawn_Redirect(arg, (mask & 1) == 0, &f_in, &f_out, &f_err); /* If the command is not found we get ENOENT under Windows. * Under Unix the information is only obtained at Pl_M_Get_Status(). */ if (pid == -1 && errno != ENOENT) Os_Test_Error(pid); /* ENOENT is for Windows */ if (pid < 0) { sprintf(err, "error trying to execute %s (maybe not found)", cmd); Pl_Err_System(Pl_Create_Allocate_Atom(err)); return FALSE; } if (mask & 1) /* pid needed ? */ Pl_Get_Integer(pid, pid_word); sprintf(pl_glob_buff, "exec_stream('%.1024s')", cmd); atom = Pl_Create_Allocate_Atom(pl_glob_buff); stm = Pl_Add_Stream_For_Stdio_Desc(f_in, atom, STREAM_MODE_WRITE, TRUE); Pl_Get_Integer(stm, stm_in_word); #ifdef DEBUG DBGPRINTF("Added Stream Input: %d\n", stm); #endif stm = Pl_Add_Stream_For_Stdio_Desc(f_out, atom, STREAM_MODE_READ, TRUE); pl_stm_tbl[stm]->prop.eof_action = STREAM_EOF_ACTION_RESET; Pl_Get_Integer(stm, stm_out_word); #ifdef DEBUG DBGPRINTF("Added Stream Output: %d\n", stm); #endif stm = Pl_Add_Stream_For_Stdio_Desc(f_err, atom, STREAM_MODE_READ, TRUE); pl_stm_tbl[stm]->prop.eof_action = STREAM_EOF_ACTION_RESET; Pl_Get_Integer(stm, stm_err_word); #ifdef DEBUG DBGPRINTF("Added Stream Error: %d\n", stm); #endif return TRUE; } /*-------------------------------------------------------------------------* * PL_CREATE_PIPE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Create_Pipe_2(WamWord stm_in_word, WamWord stm_out_word) { int p[2]; int stm; FILE *f_in, *f_out; int atom; #ifdef _WIN32 Os_Test_Error(_pipe(p, 4096, O_TEXT)); #else Os_Test_Error(pipe(p)); #endif Os_Test_Error_Null((f_in = fdopen(p[0], "rt"))); sprintf(pl_glob_buff, "pipe_stream_in"); atom = Pl_Create_Allocate_Atom(pl_glob_buff); stm = Pl_Add_Stream_For_Stdio_Desc(f_in, atom, STREAM_MODE_READ, TRUE); pl_stm_tbl[stm]->prop.eof_action = STREAM_EOF_ACTION_RESET; Pl_Get_Integer(stm, stm_in_word); Os_Test_Error_Null((f_out = fdopen(p[1], "wt"))); sprintf(pl_glob_buff, "pipe_stream_out"); atom = Pl_Create_Allocate_Atom(pl_glob_buff); stm = Pl_Add_Stream_For_Stdio_Desc(f_out, atom, STREAM_MODE_WRITE, TRUE); Pl_Get_Integer(stm, stm_out_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_FORK_PROLOG_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Fork_Prolog_1(WamWord pid_word) { #ifdef _WIN32 Pl_Err_Resource(Pl_Create_Atom("not implemented")); return FALSE; #else int pid; pid = fork(); Os_Test_Error(pid); return Pl_Get_Integer(pid, pid_word); #endif } /*-------------------------------------------------------------------------* * PL_SELECT_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Select_5(WamWord reads_word, WamWord ready_reads_word, WamWord writes_word, WamWord ready_writes_word, WamWord time_out_word) { #if defined(_WIN32) && defined(NO_USE_SOCKETS) Pl_Err_Resource(Pl_Create_Atom("not implemented")); return FALSE; #else double time_out; struct timeval *p, t; fd_set read_set, write_set; int max, n; max = Select_Init_Set(reads_word, &read_set, STREAM_CHECK_INPUT); Pl_Check_For_Un_List(ready_reads_word); n = Select_Init_Set(writes_word, &write_set, STREAM_CHECK_OUTPUT); if (n > max) max = n; Pl_Check_For_Un_List(ready_writes_word); time_out = Pl_Rd_Number_Check(time_out_word); if (time_out <= 0) p = NULL; else { t.tv_sec = (PlLong) (time_out / 1000); t.tv_usec = (PlLong) (fmod(time_out, 1000) * 1000); p = &t; } Os_Test_Error(select(max + 1, &read_set, &write_set, NULL, p)); return Select_Init_Ready_List(reads_word, &read_set, ready_reads_word) && Select_Init_Ready_List(writes_word, &write_set, ready_writes_word); #endif } /*-------------------------------------------------------------------------* * SELECT_INIT_SET * * * *-------------------------------------------------------------------------*/ static int Select_Init_Set(WamWord list_word, fd_set *set, int check) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr; int stm; int fd, max = 0; FD_ZERO(set); save_list_word = list_word; for (;;) { DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_INT_MASK) fd = Pl_Rd_Positive_Check(word); else { stm = Pl_Get_Stream_Or_Alias(word, check); fd = Pl_Io_Fileno_Of_Stream(stm); if (fd < 0) Pl_Err_Domain(pl_domain_selectable_item, word); } #if !defined(_WIN32) && defined(FD_SETSIZE) /* not true on Windows */ if (fd >= FD_SETSIZE) { errno = EBADF; Os_Test_Error(-1); } #endif FD_SET(fd, set); if (fd > max) max = fd; list_word = Cdr(lst_adr); } return max; } /*-------------------------------------------------------------------------* * SELECT_INIT_READY_LIST * * * *-------------------------------------------------------------------------*/ static Bool Select_Init_Ready_List(WamWord list_word, fd_set *set, WamWord ready_list_word) { WamWord word, tag_mask; WamWord *lst_adr; int stm; int fd; for (;;) { DEREF(list_word, word, tag_mask); if (word == NIL_WORD) break; lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_INT_MASK) fd = UnTag_INT(word); else { stm = Pl_Get_Stream_Or_Alias(word, STREAM_CHECK_VALID); fd = (stm < 0) ? -1 : Pl_Io_Fileno_Of_Stream(stm); } if (FD_ISSET(fd, set)) { if (!Pl_Get_List(ready_list_word) || !Pl_Unify_Value(word)) return FALSE; ready_list_word = Pl_Unify_Variable(); } list_word = Cdr(lst_adr); } return Pl_Get_Nil(ready_list_word); } /*-------------------------------------------------------------------------* * PL_PROLOG_PID_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Prolog_Pid_1(WamWord prolog_pid_word) { int prolog_pid; prolog_pid = (int) getpid(); return Pl_Un_Integer_Check(prolog_pid, prolog_pid_word); } /*-------------------------------------------------------------------------* * PL_SEND_SIGNAL_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Send_Signal_2(WamWord pid_word, WamWord signal_word) { WamWord word, tag_mask; int pid; int sig; int atom; int i; pid = Pl_Rd_Integer_Check(pid_word); DEREF(signal_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) { atom = UnTag_ATM(word); sig = -1; for (i = 0; i < nb_sig; i++) if (tsig[i].atom == atom) { sig = tsig[i].sig; break; } } else sig = Pl_Rd_Integer_Check(word); #ifdef _WIN32 { int ret; if (pid != _getpid()) { errno = EINVAL; ret = -1; } else { errno = 0; ret = raise(sig); } Os_Test_Error(ret); } #else Os_Test_Error(kill(pid, sig)); #endif return TRUE; } /*-------------------------------------------------------------------------* * PL_WAIT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Wait_2(WamWord pid_word, WamWord status_word) { int pid; int status; pid = Pl_Rd_Integer_Check(pid_word); Pl_Check_For_Un_Integer(status_word); status = Pl_M_Get_Status(pid); Os_Test_Error(status); return Pl_Get_Integer(status, status_word); } /*-------------------------------------------------------------------------* * GET_PATH_NAME * * * *-------------------------------------------------------------------------*/ static char * Get_Path_Name(WamWord path_name_word) { char *path_name; path_name = Pl_Rd_String_Check(path_name_word); if ((path_name = Pl_M_Absolute_Path_Name(path_name)) == NULL) Pl_Err_Domain(pl_domain_os_path, path_name_word); return path_name; } /*-------------------------------------------------------------------------* * DATE_TIME_TO_PROLOG * * * *-------------------------------------------------------------------------*/ static Bool Date_Time_To_Prolog(time_t *t, WamWord date_time_word) { WamWord word, tag_mask; WamWord year_word, month_word, day_word; WamWord hour_word, minute_word, second_word; struct tm *tm; int day, month, year; int hour, minute, second; tm = localtime(t); year = tm->tm_year + 1900; month = tm->tm_mon + 1; day = tm->tm_mday; hour = tm->tm_hour; minute = tm->tm_min; second = tm->tm_sec; DEREF(date_time_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_LST_MASK && tag_mask != TAG_STC_MASK) Pl_Err_Type(pl_type_compound, word); if (!Pl_Get_Structure(atom_dt, 6, word)) Pl_Err_Domain(pl_domain_date_time, word); year_word = Pl_Unify_Variable(); month_word = Pl_Unify_Variable(); day_word = Pl_Unify_Variable(); hour_word = Pl_Unify_Variable(); minute_word = Pl_Unify_Variable(); second_word = Pl_Unify_Variable(); Pl_Check_For_Un_Integer(year_word); Pl_Check_For_Un_Integer(month_word); Pl_Check_For_Un_Integer(day_word); Pl_Check_For_Un_Integer(hour_word); Pl_Check_For_Un_Integer(minute_word); Pl_Check_For_Un_Integer(second_word); return Pl_Get_Integer(year, year_word) && Pl_Get_Integer(month, month_word) && Pl_Get_Integer(day, day_word) && Pl_Get_Integer(hour, hour_word) && Pl_Get_Integer(minute, minute_word) && Pl_Get_Integer(second, second_word); } �������gprolog-1.4.5/src/BipsPl/c_supp.c�������������������������������������������������������������������0000644�0001750�0001750�00000224551�13021324543�014745� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : c_supp.c * * Descr.: C interface support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define CHECK_FOR_UN_VARIABLE \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK) \ Pl_Err_Uninstantiation(word) #define CHECK_FOR_UN_INTEGER \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK) \ Pl_Err_Type(pl_type_integer, word) #define CHECK_FOR_UN_POSITIVE \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK) \ Pl_Err_Type(pl_type_integer, word); \ if (tag_mask == TAG_INT_MASK && UnTag_INT(word)<0) \ Pl_Err_Domain(pl_domain_not_less_than_zero, word) #define CHECK_FOR_UN_FLOAT \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FLT_MASK) \ Pl_Err_Type(pl_type_float, word) #define CHECK_FOR_UN_NUMBER \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK && \ tag_mask != TAG_FLT_MASK) \ Pl_Err_Type(pl_type_number, word) #define CHECK_FOR_UN_ATOM \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) \ Pl_Err_Type(pl_type_atom, word) #define CHECK_FOR_UN_BOOLEAN \ WamWord word, tag_mask; \ int atom; \ \ DEREF(start_word, word, tag_mask); \ atom = UnTag_ATM(word); \ if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_ATM_MASK || \ (atom != pl_atom_true && atom != pl_atom_false))) \ Pl_Err_Type(pl_type_boolean, word) #define CHECK_FOR_UN_CHAR \ WamWord word, tag_mask; \ int atom; \ \ DEREF(start_word, word, tag_mask); \ atom = UnTag_ATM(word); \ if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_ATM_MASK || \ pl_atom_tbl[atom].prop.length != 1)) \ Pl_Err_Type(pl_type_character, word) #define CHECK_FOR_UN_IN_CHAR \ WamWord word, tag_mask; \ int atom; \ \ DEREF(start_word, word, tag_mask); \ atom = UnTag_ATM(word); \ if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_ATM_MASK || \ (atom != pl_atom_end_of_file && pl_atom_tbl[atom].prop.length != 1))) \ Pl_Err_Type(pl_type_in_character, word) #define CHECK_FOR_UN_CODE \ WamWord word, tag_mask; \ PlLong c; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK) \ Pl_Err_Type(pl_type_integer, word); \ c = UnTag_INT(word); \ if (tag_mask == TAG_INT_MASK && !Is_Valid_Code(c)) \ Pl_Err_Representation(pl_representation_character_code) #define CHECK_FOR_UN_IN_CODE \ WamWord word, tag_mask; \ PlLong c; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK) \ Pl_Err_Type(pl_type_integer, word); \ c = UnTag_INT(word); \ if (tag_mask == TAG_INT_MASK && c != -1 && !Is_Valid_Code(c)) \ Pl_Err_Representation(pl_representation_in_character_code) #define CHECK_FOR_UN_BYTE \ WamWord word, tag_mask; \ PlLong c; \ \ DEREF(start_word, word, tag_mask); \ c = UnTag_INT(word); \ if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_INT_MASK || \ !Is_Valid_Byte(c))) \ Pl_Err_Type(pl_type_byte, word) #define CHECK_FOR_UN_IN_BYTE \ WamWord word, tag_mask; \ PlLong c; \ \ DEREF(start_word, word, tag_mask); \ c = UnTag_INT(word); \ if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_INT_MASK || \ (c != -1 && !Is_Valid_Byte(c)))) \ Pl_Err_Type(pl_type_in_byte, word) #define CHECK_FOR_UN_COMPOUND \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_LST_MASK && \ tag_mask != TAG_STC_MASK) \ Pl_Err_Type(pl_type_compound, word) #define CHECK_FOR_UN_CALLABLE \ WamWord word, tag_mask; \ \ DEREF(start_word, word, tag_mask); \ if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK && \ tag_mask != TAG_LST_MASK && tag_mask != TAG_STC_MASK) \ Pl_Err_Type(pl_type_callable, word) /*-------------------------------------------------------------------------* * PL_RD_INTEGER_CHECK * * * *-------------------------------------------------------------------------*/ PlLong Pl_Rd_Integer_Check(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_integer, word); return UnTag_INT(word); } /*-------------------------------------------------------------------------* * PL_RD_INTEGER * * * *-------------------------------------------------------------------------*/ PlLong Pl_Rd_Integer(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); return UnTag_INT(word); } /*-------------------------------------------------------------------------* * PL_RD_POSITIVE_CHECK * * * *-------------------------------------------------------------------------*/ PlLong Pl_Rd_Positive_Check(WamWord start_word) { PlLong n = Pl_Rd_Integer_Check(start_word); if (n < 0) Pl_Err_Domain(pl_domain_not_less_than_zero, start_word); return n; } /*-------------------------------------------------------------------------* * PL_RD_POSITIVE * * * *-------------------------------------------------------------------------*/ PlLong Pl_Rd_Positive(WamWord start_word) { return Pl_Rd_Integer(start_word); } /*-------------------------------------------------------------------------* * PL_RD_FLOAT_CHECK * * * *-------------------------------------------------------------------------*/ double Pl_Rd_Float_Check(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_FLT_MASK) Pl_Err_Type(pl_type_float, word); return Pl_Obtain_Float(UnTag_FLT(word)); } /*-------------------------------------------------------------------------* * PL_RD_FLOAT * * * *-------------------------------------------------------------------------*/ double Pl_Rd_Float(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); return Pl_Obtain_Float(UnTag_FLT(word)); } /*-------------------------------------------------------------------------* * PL_RD_NUMBER_CHECK * * * *-------------------------------------------------------------------------*/ double Pl_Rd_Number_Check(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_FLT_MASK && tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_number, word); if (tag_mask == TAG_INT_MASK) return (double) UnTag_INT(word); return Pl_Obtain_Float(UnTag_FLT(word)); } /*-------------------------------------------------------------------------* * PL_RD_NUMBER * * * *-------------------------------------------------------------------------*/ double Pl_Rd_Number(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) return (double) UnTag_INT(word); return Pl_Obtain_Float(UnTag_FLT(word)); } /*-------------------------------------------------------------------------* * PL_RD_ATOM_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Atom_Check(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, word); return UnTag_ATM(word); } /*-------------------------------------------------------------------------* * PL_RD_ATOM * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Atom(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); return UnTag_ATM(word); } /*-------------------------------------------------------------------------* * PL_RD_BOOLEAN_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Boolean_Check(WamWord start_word) { WamWord word, tag_mask; int atom; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); atom = UnTag_ATM(word); if (tag_mask != TAG_ATM_MASK || (atom != pl_atom_true && atom != pl_atom_false)) Pl_Err_Type(pl_type_boolean, word); return atom != pl_atom_false; } /*-------------------------------------------------------------------------* * PL_RD_BOOLEAN * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Boolean(WamWord start_word) { WamWord word, tag_mask; int atom; DEREF(start_word, word, tag_mask); atom = UnTag_ATM(word); return atom != pl_atom_false; } /*-------------------------------------------------------------------------* * PL_RD_CHAR_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Char_Check(WamWord start_word) { WamWord word, tag_mask; int atom; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); atom = UnTag_ATM(word); if (tag_mask != TAG_ATM_MASK || pl_atom_tbl[atom].prop.length != 1) Pl_Err_Type(pl_type_character, word); return pl_atom_tbl[atom].name[0]; } /*-------------------------------------------------------------------------* * PL_RD_CHAR * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Char(WamWord start_word) { WamWord word, tag_mask; int atom; DEREF(start_word, word, tag_mask); atom = UnTag_ATM(word); return pl_atom_tbl[atom].name[0]; } /*-------------------------------------------------------------------------* * PL_RD_IN_CHAR_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_In_Char_Check(WamWord start_word) { WamWord word, tag_mask; int atom; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); atom = UnTag_ATM(word); if (tag_mask != TAG_ATM_MASK || (atom != pl_atom_end_of_file && pl_atom_tbl[atom].prop.length != 1)) Pl_Err_Type(pl_type_in_character, word); return (atom != pl_atom_end_of_file) ? pl_atom_tbl[atom].name[0] : -1; } /*-------------------------------------------------------------------------* * PL_RD_IN_CHAR * * * *-------------------------------------------------------------------------*/ int Pl_Rd_In_Char(WamWord start_word) { WamWord word, tag_mask; int atom; DEREF(start_word, word, tag_mask); atom = UnTag_ATM(word); return (atom != pl_atom_end_of_file) ? pl_atom_tbl[atom].name[0] : -1; } /*-------------------------------------------------------------------------* * PL_RD_CODE_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Code_Check(WamWord start_word) { int c; c = Pl_Rd_Integer_Check(start_word); if (!Is_Valid_Code(c)) Pl_Err_Representation(pl_representation_character_code); return c; } /*-------------------------------------------------------------------------* * PL_RD_CODE * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Code(WamWord start_word) { return Pl_Rd_Integer(start_word); } /*-------------------------------------------------------------------------* * PL_RD_IN_CODE_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_In_Code_Check(WamWord start_word) { int c; c = Pl_Rd_Integer_Check(start_word); if (c != -1 && !Is_Valid_Code(c)) Pl_Err_Representation(pl_representation_in_character_code); return c; } /*-------------------------------------------------------------------------* * PL_RD_IN_CODE * * * *-------------------------------------------------------------------------*/ int Pl_Rd_In_Code(WamWord start_word) { return Pl_Rd_Integer(start_word); } /*-------------------------------------------------------------------------* * PL_RD_BYTE_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Byte_Check(WamWord start_word) { WamWord word, tag_mask; PlLong c; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); c = UnTag_INT(word); if (tag_mask != TAG_INT_MASK || !Is_Valid_Byte(c)) Pl_Err_Type(pl_type_byte, word); return c; } /*-------------------------------------------------------------------------* * PL_RD_BYTE * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Byte(WamWord start_word) { return Pl_Rd_Integer(start_word); } /*-------------------------------------------------------------------------* * PL_RD_IN_BYTE_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_In_Byte_Check(WamWord start_word) { WamWord word, tag_mask; PlLong c; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); c = UnTag_INT(word); if (tag_mask != TAG_INT_MASK || (c != -1 && !Is_Valid_Byte(c))) Pl_Err_Type(pl_type_in_byte, word); return c; } /*-------------------------------------------------------------------------* * PL_RD_IN_BYTE * * * *-------------------------------------------------------------------------*/ int Pl_Rd_In_Byte(WamWord start_word) { return Pl_Rd_Integer(start_word); } /*-------------------------------------------------------------------------* * PL_RD_STRING_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Rd_String_Check(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, word); return pl_atom_tbl[UnTag_ATM(word)].name; } /*-------------------------------------------------------------------------* * PL_RD_STRING * * * *-------------------------------------------------------------------------*/ char * Pl_Rd_String(WamWord start_word) { return pl_atom_tbl[Pl_Rd_Atom(start_word)].name; } /*-------------------------------------------------------------------------* * PL_RD_CHARS_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Rd_Chars_Check(WamWord start_word) { Pl_Rd_Chars_Str_Check(start_word, pl_glob_buff); return pl_glob_buff; } /*-------------------------------------------------------------------------* * PL_RD_CHARS * * * *-------------------------------------------------------------------------*/ char * Pl_Rd_Chars(WamWord start_word) { Pl_Rd_Chars_Str(start_word, pl_glob_buff); return pl_glob_buff; } /*-------------------------------------------------------------------------* * PL_RD_CODES_CHECK * * * *-------------------------------------------------------------------------*/ char * Pl_Rd_Codes_Check(WamWord start_word) { Pl_Rd_Codes_Str_Check(start_word, pl_glob_buff); return pl_glob_buff; } /*-------------------------------------------------------------------------* * PL_RD_CODES * * * *-------------------------------------------------------------------------*/ char * Pl_Rd_Codes(WamWord start_word) { Pl_Rd_Codes_Str(start_word, pl_glob_buff); return pl_glob_buff; } /*-------------------------------------------------------------------------* * PL_RD_CHARS_STR_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Chars_Str_Check(WamWord start_word, char *str) { WamWord word, tag_mask; WamWord save_start_word; WamWord *lst_adr; int n = 0; save_start_word = start_word; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_start_word); lst_adr = UnTag_LST(word); *str++ = Pl_Rd_Char_Check(Car(lst_adr)); n++; start_word = Cdr(lst_adr); } *str = '\0'; return n; } /*-------------------------------------------------------------------------* * PL_RD_CHARS_STR * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Chars_Str(WamWord start_word, char *str) { WamWord word, tag_mask; WamWord *lst_adr; int n = 0; for (;;) { DEREF(start_word, word, tag_mask); if (word == NIL_WORD) break; lst_adr = UnTag_LST(word); *str++ = Pl_Rd_Char_Check(Car(lst_adr)); n++; start_word = Cdr(lst_adr); } *str = '\0'; return n; } /*-------------------------------------------------------------------------* * PL_RD_CODES_STR_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Codes_Str_Check(WamWord start_word, char *str) { WamWord word, tag_mask; WamWord save_start_word; WamWord *lst_adr; int n = 0; save_start_word = start_word; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_start_word); lst_adr = UnTag_LST(word); *str++ = Pl_Rd_Code_Check(Car(lst_adr)); n++; start_word = Cdr(lst_adr); } *str = '\0'; return n; } /*-------------------------------------------------------------------------* * PL_RD_CODES_STR * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Codes_Str(WamWord start_word, char *str) { WamWord word, tag_mask; WamWord *lst_adr; int n = 0; for (;;) { DEREF(start_word, word, tag_mask); if (word == NIL_WORD) break; lst_adr = UnTag_LST(word); *str++ = Pl_Rd_Code_Check(Car(lst_adr)); n++; start_word = Cdr(lst_adr); } *str = '\0'; return n; } /*-------------------------------------------------------------------------* * PL_RD_LIST_CHECK * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Rd_List_Check(WamWord start_word) { WamWord word, tag_mask; WamWord *lst_adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) return NULL; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, start_word); lst_adr = UnTag_LST(word); return &Car(lst_adr); } /*-------------------------------------------------------------------------* * PL_RD_LIST * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Rd_List(WamWord start_word) { WamWord word, tag_mask; WamWord *lst_adr; DEREF(start_word, word, tag_mask); if (word == NIL_WORD) return NULL; lst_adr = UnTag_LST(word); return &Car(lst_adr); } /*-------------------------------------------------------------------------* * PL_RD_PROPER_LIST_CHECK * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Proper_List_Check(WamWord start_word, WamWord *arg) { WamWord word, tag_mask; WamWord save_start_word; WamWord *lst_adr; int n = 0; save_start_word = start_word; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_start_word); lst_adr = UnTag_LST(word); *arg++ = Car(lst_adr); n++; start_word = Cdr(lst_adr); } return n; } /*-------------------------------------------------------------------------* * PL_RD_PROPER_LIST_CHECK2 * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Proper_List_Check2(WamWord start_word, WamWord *arg, WamWord (*elt_fct)(WamWord start_word)) { WamWord word, tag_mask; WamWord save_start_word; WamWord *lst_adr; int n = 0; save_start_word = start_word; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_start_word); lst_adr = UnTag_LST(word); *arg++ = (*elt_fct)(Car(lst_adr)); n++; start_word = Cdr(lst_adr); } return n; } /*-------------------------------------------------------------------------* * PL_RD_PROPER_LIST * * * *-------------------------------------------------------------------------*/ int Pl_Rd_Proper_List(WamWord start_word, WamWord *arg) { WamWord word, tag_mask; WamWord *lst_adr; int n = 0; for (;;) { DEREF(start_word, word, tag_mask); if (word == NIL_WORD) break; lst_adr = UnTag_LST(word); *arg++ = Car(lst_adr); n++; start_word = Cdr(lst_adr); } return n; } /*-------------------------------------------------------------------------* * PL_RD_COMPOUND_CHECK * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Rd_Compound_Check(WamWord start_word, int *func, int *arity) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); *func = ATOM_CHAR('.'); *arity = 2; return &Car(adr); } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); *func = Functor(adr); *arity = Arity(adr); return &Arg(adr, 0); } Pl_Err_Type(pl_type_compound, start_word); return NULL; } /*-------------------------------------------------------------------------* * PL_RD_COMPOUND * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Rd_Compound(WamWord start_word, int *func, int *arity) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); *func = ATOM_CHAR('.'); *arity = 2; return &Car(adr); } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); *func = Functor(adr); *arity = Arity(adr); return &Arg(adr, 0); } return NULL; } /*-------------------------------------------------------------------------* * PL_RD_CALLABLE_CHECK * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Rd_Callable_Check(WamWord start_word, int *func, int *arity) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask == TAG_ATM_MASK) { *func = UnTag_ATM(word); *arity = 0; return NULL; } if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); *func = ATOM_CHAR('.'); *arity = 2; return &Car(adr); } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); *func = Functor(adr); *arity = Arity(adr); return &Arg(adr, 0); } Pl_Err_Type(pl_type_callable, start_word); return NULL; } /*-------------------------------------------------------------------------* * PL_RD_CALLABLE * * * *-------------------------------------------------------------------------*/ WamWord * Pl_Rd_Callable(WamWord start_word, int *func, int *arity) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) { *func = UnTag_ATM(word); *arity = 0; return (WamWord *) arity; /* anything except NULL */ } if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); *func = ATOM_CHAR('.'); *arity = 2; return &Car(adr); } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); *func = Functor(adr); *arity = Arity(adr); return &Arg(adr, 0); } return NULL; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_INTEGER * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Integer(WamWord start_word) { CHECK_FOR_UN_INTEGER; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_POSITIVE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Positive(WamWord start_word) { CHECK_FOR_UN_POSITIVE; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_FLOAT * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Float(WamWord start_word) { CHECK_FOR_UN_FLOAT; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_NUMBER * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Number(WamWord start_word) { CHECK_FOR_UN_NUMBER; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_ATOM * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Atom(WamWord start_word) { CHECK_FOR_UN_ATOM; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_BOOLEAN * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Boolean(WamWord start_word) { CHECK_FOR_UN_BOOLEAN; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_CHAR * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Char(WamWord start_word) { CHECK_FOR_UN_CHAR; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_IN_CHAR * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_In_Char(WamWord start_word) { CHECK_FOR_UN_IN_CHAR; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_CODE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Code(WamWord start_word) { CHECK_FOR_UN_CODE; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_IN_CODE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_In_Code(WamWord start_word) { CHECK_FOR_UN_IN_CODE; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_BYTE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Byte(WamWord start_word) { CHECK_FOR_UN_BYTE; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_IN_BYTE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_In_Byte(WamWord start_word) { CHECK_FOR_UN_IN_BYTE; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_PAIR * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Pair(WamWord start_word) { WamWord word, tag_mask; static WamWord minus_2 = Functor_Arity(ATOM_CHAR('-'), 2); DEREF(start_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_STC_MASK || Functor_And_Arity(UnTag_STC(word)) != minus_2)) Pl_Err_Type(pl_type_pair, word); } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_CHARS * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Chars(WamWord start_word) { WamWord word, tag_mask; WamWord save_start_word; WamWord *lst_adr; save_start_word = start_word; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || word == NIL_WORD) return; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_start_word); lst_adr = UnTag_LST(word); Pl_Check_For_Un_Char(Car(lst_adr)); start_word = Cdr(lst_adr); } } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_STRING * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_String(WamWord start_word) { Pl_Check_For_Un_Atom(start_word); } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_CODES * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Codes(WamWord start_word) { WamWord word, tag_mask; WamWord save_start_word; WamWord *lst_adr; save_start_word = start_word; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || word == NIL_WORD) return; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_start_word); lst_adr = UnTag_LST(word); Pl_Check_For_Un_Code(Car(lst_adr)); start_word = Cdr(lst_adr); } } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_LIST * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_List(WamWord start_word) { if (!Pl_Blt_List_Or_Partial_List(start_word)) Pl_Err_Type(pl_type_list, start_word); } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_LIST2 * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_List2(WamWord start_word, void (*elt_fct)(WamWord start_word)) { WamWord start_word0 = start_word; WamWord word, tag_mask; WamWord *adr; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || word == NIL_WORD) return; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, start_word0); adr = UnTag_LST(word); (*elt_fct)(Car(adr)); start_word = Cdr(adr); } } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_COMPOUND * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Compound(WamWord start_word) { CHECK_FOR_UN_COMPOUND; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_CALLABLE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Callable(WamWord start_word) { CHECK_FOR_UN_CALLABLE; } /*-------------------------------------------------------------------------* * PL_CHECK_FOR_UN_VARIABLE * * * *-------------------------------------------------------------------------*/ void Pl_Check_For_Un_Variable(WamWord start_word) { CHECK_FOR_UN_VARIABLE; } /*-------------------------------------------------------------------------* * PL_UN_INTEGER_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Integer_Check(PlLong value, WamWord start_word) { CHECK_FOR_UN_INTEGER; return Pl_Get_Integer(value, word); } /*-------------------------------------------------------------------------* * PL_UN_INTEGER * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Integer(PlLong value, WamWord start_word) { return Pl_Get_Integer(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_POSITIVE_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Positive_Check(PlLong value, WamWord start_word) { CHECK_FOR_UN_POSITIVE; return Pl_Get_Integer(value, word); } /*-------------------------------------------------------------------------* * PL_UN_POSITIVE * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Positive(PlLong value, WamWord start_word) { return Pl_Get_Integer(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_FLOAT_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Float_Check(double value, WamWord start_word) { CHECK_FOR_UN_FLOAT; return Pl_Get_Float(value, word); } /*-------------------------------------------------------------------------* * PL_UN_FLOAT * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Float(double value, WamWord start_word) { return Pl_Get_Float(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_NUMBER_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Number_Check(double value, WamWord start_word) { PlLong n; CHECK_FOR_UN_NUMBER; n = (PlLong) value; return (n == value) ? Pl_Get_Integer(n, word) : Pl_Get_Float(value, word); } /*-------------------------------------------------------------------------* * PL_UN_NUMBER * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Number(double value, WamWord start_word) { PlLong n; n = (PlLong) value; return (n == value) ? Pl_Get_Integer(n, start_word) : Pl_Get_Float(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_ATOM_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Atom_Check(int value, WamWord start_word) { CHECK_FOR_UN_ATOM; return Pl_Get_Atom(value, word); } /*-------------------------------------------------------------------------* * PL_UN_ATOM * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Atom(int value, WamWord start_word) { return Pl_Get_Atom(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_BOOLEAN_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Boolean_Check(int value, WamWord start_word) { CHECK_FOR_UN_BOOLEAN; return Pl_Get_Atom(value ? pl_atom_true : pl_atom_false, word); } /*-------------------------------------------------------------------------* * PL_UN_BOOLEAN * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Boolean(int value, WamWord start_word) { return Pl_Get_Atom(value ? pl_atom_true : pl_atom_false, start_word); } /*-------------------------------------------------------------------------* * PL_UN_CHAR_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Char_Check(int value, WamWord start_word) { CHECK_FOR_UN_CHAR; return Pl_Get_Atom(ATOM_CHAR(value), word); } /*-------------------------------------------------------------------------* * PL_UN_CHAR * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Char(int value, WamWord start_word) { return Pl_Get_Atom(ATOM_CHAR(value), start_word); } /*-------------------------------------------------------------------------* * PL_UN_IN_CHAR_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_In_Char_Check(int value, WamWord start_word) { CHECK_FOR_UN_IN_CHAR; return Pl_Get_Atom((value == -1) ? pl_atom_end_of_file : ATOM_CHAR(value), word); } /*-------------------------------------------------------------------------* * PL_UN_IN_CHAR * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_In_Char(int value, WamWord start_word) { return Pl_Get_Atom((value == -1) ? pl_atom_end_of_file : ATOM_CHAR(value), start_word); } /*-------------------------------------------------------------------------* * PL_UN_CODE_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Code_Check(int value, WamWord start_word) { CHECK_FOR_UN_CODE; return Pl_Get_Integer(value, word); } /*-------------------------------------------------------------------------* * PL_UN_CODE * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Code(int value, WamWord start_word) { return Pl_Get_Integer(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_IN_CODE_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_In_Code_Check(int value, WamWord start_word) { CHECK_FOR_UN_IN_CODE; return Pl_Get_Integer(value, word); } /*-------------------------------------------------------------------------* * PL_UN_IN_CODE * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_In_Code(int value, WamWord start_word) { return Pl_Get_Integer(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_BYTE_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Byte_Check(int value, WamWord start_word) { CHECK_FOR_UN_BYTE; return Pl_Get_Integer(value, word); } /*-------------------------------------------------------------------------* * PL_UN_BYTE * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Byte(int value, WamWord start_word) { return Pl_Get_Integer(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_IN_BYTE_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_In_Byte_Check(int value, WamWord start_word) { CHECK_FOR_UN_IN_BYTE; return Pl_Get_Integer(value, word); } /*-------------------------------------------------------------------------* * PL_UN_IN_BYTE * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_In_Byte(int value, WamWord start_word) { return Pl_Get_Integer(value, start_word); } /*-------------------------------------------------------------------------* * PL_UN_STRING_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_String_Check(char *value, WamWord start_word) { CHECK_FOR_UN_ATOM; return Pl_Get_Atom(Pl_Create_Allocate_Atom(value), word); } /*-------------------------------------------------------------------------* * PL_UN_STRING * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_String(char *value, WamWord start_word) { return Pl_Get_Atom(Pl_Create_Allocate_Atom(value), start_word); } /*-------------------------------------------------------------------------* * PL_UN_CHARS_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Chars_Check(char *str, WamWord start_word) { #if 0 Pl_Check_For_Un_List(start_word); #else Pl_Check_For_Un_Chars(start_word); #endif return Pl_Un_Chars(str, start_word); } /*-------------------------------------------------------------------------* * PL_UN_CHARS * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Chars(char *str, WamWord start_word) { for (; *str; str++) { if (!Pl_Get_List(start_word) || !Pl_Unify_Atom(ATOM_CHAR(*str))) return FALSE; start_word = Pl_Unify_Variable(); } return Pl_Get_Nil(start_word); } /*-------------------------------------------------------------------------* * PL_UN_CODES_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Codes_Check(char *str, WamWord start_word) { #if 0 Pl_Check_For_Un_List(start_word); #else Pl_Check_For_Un_Codes(start_word); #endif return Pl_Un_Codes(str, start_word); } /*-------------------------------------------------------------------------* * PL_UN_CODES * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Codes(char *str, WamWord start_word) { for (; *str; str++) { if (!Pl_Get_List(start_word) || !Pl_Unify_Integer(*str)) return FALSE; start_word = Pl_Unify_Variable(); } return Pl_Get_Nil(start_word); } /*-------------------------------------------------------------------------* * PL_UN_LIST_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_List_Check(WamWord *arg, WamWord start_word) { WamWord word, tag_mask; if (arg == NULL) { if (Pl_Get_Nil(start_word)) return TRUE; check_type: DEREF(start_word, word, tag_mask); if (word != NIL_WORD && tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, start_word); return FALSE; } if (!Pl_Get_List(start_word)) goto check_type; return Pl_Unify_Value(arg[0]) && Pl_Unify_Value(arg[1]); } /*-------------------------------------------------------------------------* * PL_UN_LIST * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_List(WamWord *arg, WamWord start_word) { if (arg == NULL) return Pl_Get_Nil(start_word); return Pl_Get_List(start_word) && Pl_Unify_Value(arg[0]) && Pl_Unify_Value(arg[1]); } /*-------------------------------------------------------------------------* * PL_UN_PROPER_LIST_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Proper_List_Check(int n, WamWord *arg, WamWord start_word) { Pl_Check_For_Un_List(start_word); return Pl_Un_Proper_List(n, arg, start_word); } /*-------------------------------------------------------------------------* * PL_UN_PROPER_LIST * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Proper_List(int n, WamWord *arg, WamWord start_word) { if (n < 0 || arg == NULL) n = 0; while (n--) { if (!Pl_Get_List(start_word) || !Pl_Unify_Value(*arg++)) return FALSE; start_word = Pl_Unify_Variable(); } return Pl_Get_Nil(start_word); } /*-------------------------------------------------------------------------* * PL_UN_COMPOUND_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Compound_Check(int func, int arity, WamWord *arg, WamWord start_word) { int i; if (arity == 0) return Pl_Un_Atom_Check(func, start_word); if (arity == 2 && func == ATOM_CHAR('.')) return Pl_Un_List_Check(arg, start_word); if (!Pl_Get_Structure(func, arity, start_word)) { if (!Pl_Blt_Compound(start_word)) Pl_Err_Type(pl_type_compound, start_word); return FALSE; } for (i = 0; i < arity; i++) if (!Pl_Unify_Value(arg[i])) return FALSE; return TRUE; } /*-------------------------------------------------------------------------* * PL_UN_COMPOUND * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Compound(int func, int arity, WamWord *arg, WamWord start_word) { int i; if (arity == 0) return Pl_Un_Atom_Check(func, start_word); if (arity == 2 && func == ATOM_CHAR('.')) return Pl_Un_List(arg, start_word); if (!Pl_Get_Structure(func, arity, start_word)) return FALSE; for (i = 0; i < arity; i++) if (!Pl_Unify_Value(arg[i])) return FALSE; return TRUE; } /*-------------------------------------------------------------------------* * PL_UN_CALLABLE_CHECK * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Callable_Check(int func, int arity, WamWord *arg, WamWord start_word) { int i; if (arity == 0) return Pl_Un_Atom_Check(func, start_word); if (arity == 2 && func == ATOM_CHAR('.')) return Pl_Un_List_Check(arg, start_word); if (!Pl_Get_Structure(func, arity, start_word)) { if (!Pl_Blt_Callable(start_word)) Pl_Err_Type(pl_type_callable, start_word); return FALSE; } for (i = 0; i < arity; i++) if (!Pl_Unify_Value(arg[i])) return FALSE; return TRUE; } /*-------------------------------------------------------------------------* * PL_UN_CALLABLE * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Callable(int func, int arity, WamWord *arg, WamWord start_word) { return Pl_Un_Compound(func, arity, arg, start_word); } /*-------------------------------------------------------------------------* * PL_UN_TERM * * * *-------------------------------------------------------------------------*/ Bool Pl_Un_Term(WamWord term_word, WamWord start_word) { /* used because Unify is FC convention */ return Pl_Unify(term_word, start_word); } /*-------------------------------------------------------------------------* * PL_MK_INTEGER * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Integer(PlLong value) { return Pl_Put_Integer(value); } /*-------------------------------------------------------------------------* * PL_MK_POSITIVE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Positive(PlLong value) { return Pl_Put_Integer(value); } /*-------------------------------------------------------------------------* * PL_MK_FLOAT * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Float(double value) { return Pl_Put_Float(value); } /*-------------------------------------------------------------------------* * PL_MK_NUMBER * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Number(double value) { int n; n = (PlLong) value; if (n == value) return Pl_Put_Integer(n); return Pl_Put_Float(value); } /*-------------------------------------------------------------------------* * PL_MK_ATOM * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Atom(int value) { return Pl_Put_Atom(value); } /*-------------------------------------------------------------------------* * PL_MK_BOOLEAN * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Boolean(int value) { return Pl_Put_Atom(value ? pl_atom_true : pl_atom_false); } /*-------------------------------------------------------------------------* * PL_MK_CHAR * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Char(int value) { return Pl_Put_Atom(ATOM_CHAR(value)); } /*-------------------------------------------------------------------------* * PL_MK_IN_CHAR * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_In_Char(int value) { return Pl_Put_Atom((value == -1) ? pl_atom_end_of_file : ATOM_CHAR(value)); } /*-------------------------------------------------------------------------* * PL_MK_CODE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Code(int value) { return Pl_Put_Integer(value); } /*-------------------------------------------------------------------------* * PL_MK_IN_CODE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_In_Code(int value) { return Pl_Put_Integer(value); } /*-------------------------------------------------------------------------* * PL_MK_BYTE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Byte(int value) { return Pl_Put_Integer(value); } /*-------------------------------------------------------------------------* * PL_MK_IN_BYTE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_In_Byte(int value) { return Pl_Put_Integer(value); } /*-------------------------------------------------------------------------* * PL_MK_STRING * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_String(char *value) { return Pl_Put_Atom(Pl_Create_Allocate_Atom(value)); } /*-------------------------------------------------------------------------* * PL_MK_CHARS * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Chars(char *str) { WamWord res_word; if (*str == '\0') return NIL_WORD; res_word = Pl_Put_List(); for (;;) { Pl_Unify_Atom(ATOM_CHAR(*str)); str++; if (*str == '\0') break; Pl_Unify_List(); } Pl_Unify_Nil(); return res_word; } /*-------------------------------------------------------------------------* * PL_MK_CODES * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Codes(char *str) { WamWord res_word; if (*str == '\0') return NIL_WORD; res_word = Pl_Put_List(); for (;;) { Pl_Unify_Integer(*str); str++; if (*str == '\0') break; Pl_Unify_List(); } Pl_Unify_Nil(); return res_word; } /*-------------------------------------------------------------------------* * PL_MK_LIST * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_List(WamWord *arg) { WamWord res_word; if (arg == NULL) return NIL_WORD; res_word = Pl_Put_List(); Pl_Unify_Value(arg[0]); Pl_Unify_Value(arg[1]); return res_word; } /*-------------------------------------------------------------------------* * PL_MK_PROPER_LIST * * * * This function transform an array of n WamWords located at arg into a * * Prolog list (pushed at the top of the heap) and returns the resulting * * list word. * * Note: arg can be equal to H to tranform an array into a list in-place. * * The resulting list uses 2*n WamWord from the top of the heap. * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Proper_List(int n, WamWord *arg) { WamWord *src, *dst, *p; if (n <= 0 || arg == NULL) return NIL_WORD; src = arg + n; /* copy from end to start to make possible */ dst = H = H + 2 * n; /* in-place array->list transformation */ *--dst = NIL_WORD; goto entry; do { p = dst--; *dst = Tag_LST(p); entry: *--dst = *--src; } while (--n); return Tag_LST(dst); } /*-------------------------------------------------------------------------* * PL_MK_COMPOUND * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Compound(int func, int arity, WamWord *arg) { WamWord res_word; int i; if (arity == 0) return Pl_Put_Atom(func); if (arity == 2 && func == ATOM_CHAR('.')) return Pl_Mk_List(arg); res_word = Pl_Put_Structure(func, arity); for (i = 0; i < arity; i++) Pl_Unify_Value(arg[i]); return res_word; } /*-------------------------------------------------------------------------* * PL_MK_CALLABLE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Callable(int func, int arity, WamWord *arg) { return Pl_Mk_Compound(func, arity, arg); } /*-------------------------------------------------------------------------* * PL_MK_VARIABLE * * * *-------------------------------------------------------------------------*/ WamWord Pl_Mk_Variable(void) { return Pl_Put_X_Variable(); } �������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/const_io.pl����������������������������������������������������������������0000644�0001750�0001750�00000016326�13021324543�015461� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : const_io.pl * * Descr.: input/output from/to constant term management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_const_io'. write_to_atom(Atom, Term) :- set_bip_name(write_to_atom, 2), '$call_c_test'('Pl_Write_To_Atom_2'(Atom, Term)). write_to_chars(Chars, Term) :- set_bip_name(write_to_chars, 2), '$call_c_test'('Pl_Write_To_Chars_2'(Chars, Term)). write_to_codes(Codes, Term) :- set_bip_name(write_to_codes, 2), '$call_c_test'('Pl_Write_To_Codes_2'(Codes, Term)). writeq_to_atom(Atom, Term) :- set_bip_name(writeq_to_atom, 2), '$call_c_test'('Pl_Writeq_To_Atom_2'(Atom, Term)). writeq_to_chars(Chars, Term) :- set_bip_name(writeq_to_chars, 2), '$call_c_test'('Pl_Writeq_To_Chars_2'(Chars, Term)). writeq_to_codes(Codes, Term) :- set_bip_name(writeq_to_codes, 2), '$call_c_test'('Pl_Writeq_To_Codes_2'(Codes, Term)). write_canonical_to_atom(Atom, Term) :- set_bip_name(write_canonical_to_atom, 2), '$call_c_test'('Pl_Write_Canonical_To_Atom_2'(Atom, Term)). write_canonical_to_chars(Chars, Term) :- set_bip_name(write_canonical_to_chars, 2), '$call_c_test'('Pl_Write_Canonical_To_Chars_2'(Chars, Term)). write_canonical_to_codes(Codes, Term) :- set_bip_name(write_canonical_to_codes, 2), '$call_c_test'('Pl_Write_Canonical_To_Codes_2'(Codes, Term)). display_to_atom(Atom, Term) :- set_bip_name(display_to_atom, 2), '$call_c_test'('Pl_Display_To_Atom_2'(Atom, Term)). display_to_chars(Chars, Term) :- set_bip_name(display_to_chars, 2), '$call_c_test'('Pl_Display_To_Chars_2'(Chars, Term)). display_to_codes(Codes, Term) :- set_bip_name(display_to_codes, 2), '$call_c_test'('Pl_Display_To_Codes_2'(Codes, Term)). print_to_atom(Atom, Term) :- set_bip_name(print_to_atom, 2), '$call_c_test'('Pl_Print_To_Atom_2'(Atom, Term)). print_to_chars(Chars, Term) :- set_bip_name(print_to_chars, 2), '$call_c_test'('Pl_Print_To_Chars_2'(Chars, Term)). print_to_codes(Codes, Term) :- set_bip_name(print_to_codes, 2), '$call_c_test'('Pl_Print_To_Codes_2'(Codes, Term)). write_term_to_atom(Atom, Term, Options) :- set_bip_name(write_term_to_atom, 3), '$set_write_defaults', '$get_write_options'(Options), '$call_c'('Pl_Write_Term_To_Atom_2'(Atom, Term)). write_term_to_chars(Chars, Term, Options) :- set_bip_name(write_term_to_chars, 3), '$set_write_defaults', '$get_write_options'(Options), '$call_c'('Pl_Write_Term_To_Chars_2'(Chars, Term)). write_term_to_codes(Codes, Term, Options) :- set_bip_name(write_term_to_codes, 3), '$set_write_defaults', '$get_write_options'(Options), '$call_c'('Pl_Write_Term_To_Codes_2'(Codes, Term)). format_to_atom(Atom, Format, Args) :- set_bip_name(format_to_atom, 3), '$call_c_test'('Pl_Format_To_Atom_3'(Atom, Format, Args)). format_to_chars(Chars, Format, Args) :- set_bip_name(format_to_chars, 3), '$call_c_test'('Pl_Format_To_Chars_3'(Chars, Format, Args)). format_to_codes(Codes, Format, Args) :- set_bip_name(format_to_codes, 3), '$call_c_test'('Pl_Format_To_Codes_3'(Codes, Format, Args)). read_from_atom(Atom, Term) :- set_bip_name(read_from_atom, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_From_Atom_2'(Atom, Term)). read_from_chars(Chars, Term) :- set_bip_name(read_from_chars, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_From_Chars_2'(Chars, Term)). read_from_codes(Codes, Term) :- set_bip_name(read_from_codes, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_From_Codes_2'(Codes, Term)). read_term_from_atom(Atom, Term, Options) :- set_bip_name(read_term_from_atom, 3), '$set_read_defaults', '$get_read_options'(Options, Vars, VarNames, SinglNames), '$call_c_test'('Pl_Read_Term_From_Atom_5'(Atom, Term, Vars, VarNames, SinglNames)). read_term_from_chars(Chars, Term, Options) :- set_bip_name(read_term_from_chars, 3), '$set_read_defaults', '$get_read_options'(Options, Vars, VarNames, SinglNames), '$call_c_test'('Pl_Read_Term_From_Chars_5'(Chars, Term, Vars, VarNames, SinglNames)). read_term_from_codes(Codes, Term, Options) :- set_bip_name(read_term_from_codes, 3), '$set_read_defaults', '$get_read_options'(Options, Vars, VarNames, SinglNames), '$call_c_test'('Pl_Read_Term_From_Codes_5'(Codes, Term, Vars, VarNames, SinglNames)). read_token_from_atom(Atom, Token) :- set_bip_name(read_token_from_atom, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_Token_From_Atom_2'(Atom, Token)). read_token_from_chars(Chars, Token) :- set_bip_name(read_token_from_chars, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_Token_From_Chars_2'(Chars, Token)). read_token_from_codes(Codes, Token) :- set_bip_name(read_token_from_codes, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_Token_From_Codes_2'(Codes, Token)). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/print.wam������������������������������������������������������������������0000644�0001750�0001750�00000003746�13021356407�015157� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : print.pl file_name('/home/diaz/GP/src/BipsPl/print.pl'). predicate(system:'$use_print'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:print/1,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[print,1]), call_c('Pl_Print_1',[],[x(0)]), proceed]). predicate(system:print/2,48,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[print,2]), call_c('Pl_Print_2',[],[x(0),x(1)]), proceed]). predicate(system:'$try_portray'/1,55,static,private,monofile,built_in,[ try_me_else(1), allocate(1), get_variable(y(0),0), put_structure((/)/2,0), unify_atom(portray), unify_integer(1), put_meta_term(system,0,0), call('$current_predicate'/1), put_atom('$portray_ok',0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_structure(format/3,0), unify_atom(top_level_output), unify_atom('exception from portray/1: ~q~n'), unify_list, unify_variable(x(1)), unify_nil, put_structure((',')/2,2), unify_value(x(0)), unify_atom(fail), put_structure(portray/1,3), unify_local_value(y(0)), put_structure((',')/2,0), unify_value(x(3)), unify_atom(!), put_atom(user,3), put_atom(portray,4), put_integer(1,5), call('$catch'/6), put_atom('$portray_ok',0), put_integer(1,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), fail, label(1), trust_me_else_fail, put_atom('$portray_ok',0), put_integer(1,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:get_print_stream/1,68,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_print_stream,1]), put_variable(y(0),1), call('$check_stream_or_var'/2), put_unsafe_value(y(0),0), deallocate, call_c('Pl_Get_Print_Stm_1',[],[x(0)]), proceed]). ��������������������������gprolog-1.4.5/src/BipsPl/write.wam������������������������������������������������������������������0000644�0001750�0001750�00000030233�13021356407�015144� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : write.pl file_name('/home/diaz/GP/src/BipsPl/write.pl'). predicate(system:'$use_write'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:write/1,49,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write,1]), call_c('Pl_Write_1',[],[x(0)]), proceed]). predicate(system:write/2,53,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write,2]), call_c('Pl_Write_2',[],[x(0),x(1)]), proceed]). predicate(system:writeq/1,60,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[writeq,1]), call_c('Pl_Writeq_1',[],[x(0)]), proceed]). predicate(system:writeq/2,64,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[writeq,2]), call_c('Pl_Writeq_2',[],[x(0),x(1)]), proceed]). predicate(system:write_canonical/1,71,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_canonical,1]), call_c('Pl_Write_Canonical_1',[],[x(0)]), proceed]). predicate(system:write_canonical/2,75,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_canonical,2]), call_c('Pl_Write_Canonical_2',[],[x(0),x(1)]), proceed]). predicate(system:display/1,82,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[display,1]), call_c('Pl_Display_1',[],[x(0)]), proceed]). predicate(system:display/2,86,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[display,2]), call_c('Pl_Display_2',[],[x(0),x(1)]), proceed]). predicate(system:write_term/2,110,static,private,monofile,built_in,[ try_me_else(1), allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_term,2]), call('$set_write_defaults'/0), put_value(y(1),0), call('$get_write_options'/1), put_value(y(0),0), call_c('Pl_Write_Term_1',[],[x(0)]), fail, label(1), trust_me_else_fail, proceed]). predicate(system:write_term/3,120,static,private,monofile,built_in,[ try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_term,3]), call('$set_write_defaults'/0), put_value(y(2),0), call('$get_write_options'/1), put_value(y(0),0), put_value(y(1),1), call_c('Pl_Write_Term_2',[],[x(0),x(1)]), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$set_write_defaults'/0,131,static,private,monofile,built_in,[ allocate(0), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_integer(1,0), put_integer(-1,1), call('$sys_var_write'/2), put_integer(2,0), put_integer(1200,1), call('$sys_var_write'/2), put_integer(3,0), put_integer(0,1), deallocate, execute('$sys_var_write'/2)]). predicate(system:'$get_write_options'/1,140,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), put_value(y(0),0), call('$check_list'/1), put_value(y(0),0), call('$get_write_options1'/1), deallocate, execute('$$get_write_options/1_$aux1'/0)]). predicate(system:'$$get_write_options/1_$aux1'/0,140,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), allocate(1), get_variable(y(0),0), put_integer(0,0), put_integer(6,1), put_integer(1,2), call('$sys_var_get_bit'/3), cut(y(0)), put_integer(0,0), put_integer(3,1), deallocate, execute('$sys_var_set_bit'/2), label(1), trust_me_else_fail, proceed]). predicate(system:'$get_write_options1'/1,151,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call('$get_write_options2'/1), cut(y(1)), put_value(y(0),0), deallocate, execute('$get_write_options1'/1)]). predicate(system:'$get_write_options2'/1,158,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(23), switch_on_term(3,fail,fail,fail,2), label(2), switch_on_structure([(quoted/1,4),(ignore_ops/1,6),(numbervars/1,8),(namevars/1,10),('$above'/1,12),(space_args/1,14),(portrayed/1,16),(variable_names/1,18),(max_depth/1,20),(priority/1,22)]), label(3), try_me_else(5), label(4), allocate(1), get_structure(quoted/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_write_options2/1_$aux1'/1), label(5), retry_me_else(7), label(6), allocate(1), get_structure(ignore_ops/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_write_options2/1_$aux2'/1), label(7), retry_me_else(9), label(8), allocate(1), get_structure(numbervars/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_write_options2/1_$aux3'/1), label(9), retry_me_else(11), label(10), allocate(1), get_structure(namevars/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_write_options2/1_$aux4'/1), label(11), retry_me_else(13), label(12), allocate(1), get_structure('$above'/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_integer(3,0), put_value(y(0),1), deallocate, execute('$sys_var_write'/2), label(13), retry_me_else(15), label(14), allocate(1), get_structure(space_args/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_write_options2/1_$aux5'/1), label(15), retry_me_else(17), label(16), allocate(1), get_structure(portrayed/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_write_options2/1_$aux6'/1), label(17), retry_me_else(19), label(18), allocate(1), get_structure(variable_names/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_integer(0,0), put_integer(6,1), call('$sys_var_set_bit'/2), put_value(y(0),0), deallocate, execute('$name_variables'/1), label(19), retry_me_else(21), label(20), allocate(1), get_structure(max_depth/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_integer(1,0), put_value(y(0),1), deallocate, execute('$sys_var_write'/2), label(21), trust_me_else_fail, label(22), allocate(1), get_structure(priority/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_integer(2,0), put_value(y(0),1), deallocate, execute('$sys_var_write'/2), label(23), trust_me_else_fail, put_value(x(0),1), put_atom(write_option,0), execute('$pl_err_domain'/2)]). predicate(system:'$$get_write_options2/1_$aux6'/1,207,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(5,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(5,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_write_options2/1_$aux5'/1,199,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(4,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(4,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_write_options2/1_$aux4'/1,186,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(3,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(3,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_write_options2/1_$aux3'/1,178,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(2,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(2,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_write_options2/1_$aux2'/1,170,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(1,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(1,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_write_options2/1_$aux1'/1,162,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$name_variables'/1,236,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, switch_on_term(2,3,fail,5,fail), label(2), try_me_else(4), label(3), get_nil(0), proceed, label(4), trust_me_else_fail, label(5), allocate(4), get_list(0), unify_variable(x(0)), unify_variable(y(2)), get_structure((=)/2,0), unify_variable(y(0)), unify_variable(y(1)), get_variable(y(3),1), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), put_value(y(1),0), put_value(y(0),1), put_value(y(3),2), call('$$name_variables/1_$aux1'/3), put_value(y(2),0), deallocate, execute('$name_variables'/1)]). predicate(system:'$$name_variables/1_$aux1'/3,242,static,private,monofile,local,[ try_me_else(1), get_structure('$VARNAME'/1,0), unify_local_value(x(1)), cut(x(2)), proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$is_valid_var_name'/1,251,static,private,monofile,built_in,[ call_c('Pl_Is_Valid_Var_Name_1',[boolean],[x(0)]), proceed]). predicate(system:nl/0,256,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[nl,0]), call_c('Pl_Nl_0',[],[]), proceed]). predicate(system:nl/1,260,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[nl,1]), call_c('Pl_Nl_1',[],[x(0)]), proceed]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pred.pl��������������������������������������������������������������������0000644�0001750�0001750�00000025042�13021324543�014571� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pred.pl * * Descr.: predicate manipulation management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_pred'. current_module(Module) :- set_bip_name(current_module, 1), '$current_module'(Module). '$current_module'(Module) :- '$call_c_test'('Pl_Current_Module_2'(Module, 0)). '$current_module_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Module_Alt_0'). '$current_module_relax'(Module) :- atom(Module), !. % accept any atom (does not fail if not exists) '$current_module_relax'(Module) :- '$current_module'(Module). '$select_module'(0, Module, Module). % 0 = module only '$select_module'(1, Module, Module) :- % 1 = module + user ( Module \== user, Module \== system -> true ; ! ). '$select_module'(1, _, user). '$select_module'(2, Module, Module) :- % 2 = module + user + system Module \== user, Module \== system. '$select_module'(2, Module, user) :- Module \== system. '$select_module'(2, _, system). :- meta_predicate(current_predicate(:)). current_predicate(MPI) :- set_bip_name(current_predicate, 1), '$current_predicate'(MPI, 0, 0). :- meta_predicate('$current_predicate'(:)). '$current_predicate'(MPI) :- '$current_predicate'(MPI, 0, 0). :- meta_predicate('$current_predicate_any'(:)). '$current_predicate_any'(MPI) :- '$current_predicate'(MPI, 2, 1). % also dollar /* '$current_predicate' expects a qualified PI */ % WhichModule = 0=only given, 1=include user, 2=include user and system % AlsoMask = Import(0/1) Dollar(0/1) '$current_predicate'(MPI, WhichModule, AlsoMask) :- '$strip_module_var'(MPI, HomeModule, PI), %write('home_module'(HomeModule)),nl, '$current_module_relax'(HomeModule), %write('home_module'(HomeModule)),nl, '$select_module'(WhichModule, HomeModule, Module), %write('module'(Module)),nl, '$call_c_test'('Pl_Current_Predicate_4'(Module, HomeModule, PI, AlsoMask)). '$current_predicate_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Predicate_Alt_0'). /* From 1.4.0 predicate_property only accepts a Head which is a callable. * In previous versions a predicate_indicator was expected, a callable was * accepted iff strict_iso was off. * This is no longer the case. */ :- meta_predicate(predicate_property(:, ?)). predicate_property(MHead, Property) :- set_bip_name(predicate_property, 2), '$predicate_property'(MHead, Property, 2, 0). :- meta_predicate('$predicate_property'(:, ?)). '$predicate_property'(MHead, Property) :- '$predicate_property'(MHead, Property, 2, 0). :- meta_predicate('$predicate_property_any'(:, ?)). '$predicate_property_any'(MHead, Property) :- '$predicate_property'(MHead, Property, 2, 1). % also dollar /* '$predicate_property' expects a qualified head */ % WhichModule = 0=only given, 1=include user, 2=include user and system % AlsoMask = Import(0/1) Dollar(0/1) '$predicate_property'(MHead, Property, WhichModule, AlsoMask) :- '$strip_module_var'(MHead, HomeModule, Head), '$current_module_relax'(HomeModule), '$select_module'(WhichModule, HomeModule, Module), '$head_to_fn'(Head, F, N), '$call_c_test'('Pl_Current_Predicate_4'(Module, HomeModule, F/N, AlsoMask)), functor(Head, F, N), ( '$predicate_property1'(Module, F, N, Property) ; HomeModule \== Module, Property = imported_from(Module) ). '$head_to_fn'(Head, F, N) :- callable(Head), !, functor(Head, F, N). '$head_to_fn'(Head, _, _) :- var(Head), !. '$head_to_fn'(Head, _, _) :- '$pl_err_type'(callable, Head). % FIXME: when stable remove it (used in read_file.pl/syn_sugar.pl % to test built_in, pass system in both cases) '$predicate_property1'(Func, Arity, Property) :- '$predicate_property1'(system, Func, Arity, Property). % here Module, Func, Arity are instantiated '$predicate_property1'(Module, Func, Arity, Property) :- '$check_pred_prop'(Property), !, '$predicate_property2'(Property, Module, Func, Arity). '$check_pred_prop'(Property) :- var(Property). '$check_pred_prop'(static). '$check_pred_prop'(dynamic). '$check_pred_prop'(private). '$check_pred_prop'(public). '$check_pred_prop'(monofile). '$check_pred_prop'(multifile). '$check_pred_prop'(user). '$check_pred_prop'(built_in). '$check_pred_prop'(built_in_fd). '$check_pred_prop'(control_construct). '$check_pred_prop'(native_code). '$check_pred_prop'(prolog_file(_)). '$check_pred_prop'(prolog_line(_)). '$check_pred_prop'(meta_predicate(_)). '$check_pred_prop'(imported_from(_)). '$check_pred_prop'(Property) :- '$pl_err_domain'(predicate_property, Property). '$predicate_property2'(static, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Static_2'(Module, Func, Arity)). '$predicate_property2'(dynamic, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Dynamic_2'(Module, Func, Arity)). '$predicate_property2'(private, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Private_2'(Module, Func, Arity)). '$predicate_property2'(public, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Public_2'(Module, Func, Arity)). '$predicate_property2'(monofile, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Monofile_2'(Module, Func, Arity)). '$predicate_property2'(multifile, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Multifile_2'(Module, Func, Arity)). '$predicate_property2'(user, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_User_2'(Module, Func, Arity)). '$predicate_property2'(built_in, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Built_In_2'(Module, Func, Arity)). '$predicate_property2'(built_in_fd, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Built_In_Fd_2'(Module, Func, Arity)). '$predicate_property2'(control_construct, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Control_Construct_2'(Module, Func, Arity)). '$predicate_property2'(native_code, Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Native_Code_2'(Module, Func, Arity)). '$predicate_property2'(prolog_file(PlFile), Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Prolog_File_3'(Module, Func, Arity, PlFile)). '$predicate_property2'(prolog_line(PlLine), Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Prolog_Line_3'(Module, Func, Arity, PlLine)). '$predicate_property2'(meta_predicate(MetaPredSpec), Module, Func, Arity) :- '$call_c_test'('Pl_Pred_Prop_Meta_Predicate_3'(Module, Func, Arity, MetaPredSpec)). '$get_predicate_file_info'(Module, F, N, PlFile, PlLine) :- '$call_c_test'('Pl_Get_Predicate_File_Info_5'(Module, F, N, PlFile, PlLine)). '$set_predicate_file_info'(Module, F, N, PlFile, PlLine) :- '$call_c_test'('Pl_Set_Predicate_File_Info_5'(Module, F, N, PlFile, PlLine)). '$get_module_of_pred'(HomeModule, Func, Arity, Module) :- '$call_c_test'('Pl_Get_Module_Of_Pred_4'(HomeModule, Func, Arity, Module)). '$get_module_of_goal'(HomeModule, Goal, Module) :- '$call_c_test'('Pl_Get_Module_Of_Goal_3'(HomeModule, Goal, Module)). '$get_module_of_goal_if_not_meta_pred'(HomeModule, Goal, Module) :- '$call_c_test'('Pl_Get_Module_Of_Goal_If_Not_Meta_Pred_3'(HomeModule, Goal, Module)). '$aux_name'(Name) :- '$call_c_test'('Pl_Aux_Name_1'(Name)). '$father_of_aux_name'(Name, FatherName, FatherArity) :- '$call_c_test'('Pl_Father_Of_Aux_Name_3'(Name, FatherName, FatherArity)). '$pred_without_aux'(Name, Arity, Name1, Arity1) :- '$call_c_test'('Pl_Pred_Without_Aux_4'(Name, Arity, Name1, Arity1)). '$make_aux_name'(Name, Arity, AuxNb, AuxName) :- '$call_c_test'('Pl_Make_Aux_Name_4'(Name, Arity, AuxNb, AuxName)). '$declare_meta_predicate'(Module, MetaPredSpec) :- '$call_c_test'('Pl_Decl_Meta_Pred_2'(Module, MetaPredSpec)). :- meta_predicate(strip_module(:, ?, ?)). strip_module(Term, Module, Plain) :- '$call_c_test'('Pl_Strip_Module_3'(Term, Module, Plain)). % these 2 sets the calling module '$strip_module_var'(Term, Module, Plain) :- '$call_c_test'('Pl_Strip_Module_Var_3'(Term, Module, Plain)). '$strip_module_nonvar'(Term, Module, Plain) :- '$call_c_test'('Pl_Strip_Module_Nonvar_3'(Term, Module, Plain)). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/utils.wam������������������������������������������������������������������0000644�0001750�0001750�00000010242�13021356407�015150� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : utils.pl file_name('/home/diaz/GP/src/BipsPl/utils.pl'). predicate(system:'$get_head_and_body'/4,41,static,private,monofile,built_in,[ call_c('Pl_Get_Head_And_Body_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$term_to_goal'/4,44,static,private,monofile,built_in,[ call_c('Pl_Term_To_Goal_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$check_list'/1,118,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_List',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), retry_me_else(2), call_c('Pl_Blt_List_Or_Partial_List',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(2), trust_me_else_fail, put_value(x(0),1), put_atom(list,0), execute('$pl_err_type'/2)]). predicate(system:'$check_list_or_partial_list'/1,131,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_List_Or_Partial_List',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_value(x(0),1), put_atom(list,0), execute('$pl_err_type'/2)]). predicate(system:'$check_atom_or_atom_list'/1,140,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),1), call('$check_atom_or_atom_list1'/1), cut(y(0)), deallocate, proceed]). predicate(system:'$check_atom_or_atom_list1'/1,147,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(6), switch_on_term(2,3,fail,5,fail), label(2), try_me_else(4), label(3), get_nil(0), proceed, label(4), trust_me_else_fail, label(5), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), call('$check_atom_or_atom_list2'/1), put_value(y(0),0), deallocate, execute('$check_atom_or_atom_list1'/1), label(6), trust_me_else_fail, put_value(x(0),1), put_atom(list,0), execute('$pl_err_type'/2)]). predicate(system:'$check_atom_or_atom_list2'/1,161,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_variable(y(0),1), put_void(1), put_variable(y(1),2), call('$strip_module_nonvar'/3), put_unsafe_value(y(1),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_value(x(0),1), put_atom(atom,0), execute('$pl_err_type'/2)]). predicate(system:'$check_head'/1,179,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, execute('$$check_head/1_$aux1'/1)]). predicate(system:'$$check_head/1_$aux1'/1,183,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_value(x(0),1), put_atom(callable,0), execute('$pl_err_type'/2)]). predicate(system:'$check_nonvar'/1,192,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, execute('$pl_err_instantiation'/0)]). predicate(system:'$get_pred_indic'/5,203,static,private,monofile,built_in,[ call_c('Pl_Get_Pred_Indic_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:'$get_pred_indic_var'/5,207,static,private,monofile,built_in,[ call_c('Pl_Get_Pred_Indic_Var_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/char_io.wam����������������������������������������������������������������0000644�0001750�0001750�00000013163�13021356407�015421� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : char_io.pl file_name('/home/diaz/GP/src/BipsPl/char_io.pl'). predicate(system:'$use_char_io'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:get_key/1,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_key,1]), call_c('Pl_Get_Key_1',[boolean],[x(0)]), proceed]). predicate(system:get_key/2,48,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_key,2]), call_c('Pl_Get_Key_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:get_key_no_echo/1,53,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_key_no_echo,1]), call_c('Pl_Get_Key_No_Echo_1',[boolean],[x(0)]), proceed]). predicate(system:get_key_no_echo/2,57,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_key_no_echo,2]), call_c('Pl_Get_Key_No_Echo_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:get_char/1,66,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_char,1]), call_c('Pl_Get_Char_1',[boolean],[x(0)]), proceed]). predicate(system:get_char/2,70,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_char,2]), call_c('Pl_Get_Char_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:get_code/1,77,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_code,1]), call_c('Pl_Get_Code_1',[boolean],[x(0)]), proceed]). predicate(system:get_code/2,81,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_code,2]), call_c('Pl_Get_Code_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:get_byte/1,88,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_byte,1]), call_c('Pl_Get_Byte_1',[boolean],[x(0)]), proceed]). predicate(system:get_byte/2,92,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_byte,2]), call_c('Pl_Get_Byte_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:unget_char/1,102,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unget_char,1]), call_c('Pl_Unget_Char_1',[],[x(0)]), proceed]). predicate(system:unget_char/2,106,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unget_char,2]), call_c('Pl_Unget_Char_2',[],[x(0),x(1)]), proceed]). predicate(system:unget_code/1,113,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unget_code,1]), call_c('Pl_Unget_Code_1',[],[x(0)]), proceed]). predicate(system:unget_code/2,117,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unget_code,2]), call_c('Pl_Unget_Code_2',[],[x(0),x(1)]), proceed]). predicate(system:unget_byte/1,124,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unget_byte,1]), call_c('Pl_Unget_Byte_1',[],[x(0)]), proceed]). predicate(system:unget_byte/2,128,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unget_byte,2]), call_c('Pl_Unget_Byte_2',[],[x(0),x(1)]), proceed]). predicate(system:peek_char/1,137,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[peek_char,1]), call_c('Pl_Peek_Char_1',[boolean],[x(0)]), proceed]). predicate(system:peek_char/2,141,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[peek_char,2]), call_c('Pl_Peek_Char_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:peek_code/1,148,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[peek_code,1]), call_c('Pl_Peek_Code_1',[boolean],[x(0)]), proceed]). predicate(system:peek_code/2,152,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[peek_code,2]), call_c('Pl_Peek_Code_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:peek_byte/1,159,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[peek_byte,1]), call_c('Pl_Peek_Byte_1',[boolean],[x(0)]), proceed]). predicate(system:peek_byte/2,163,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[peek_byte,2]), call_c('Pl_Peek_Byte_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:put_char/1,172,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put_char,1]), call_c('Pl_Put_Char_1',[],[x(0)]), proceed]). predicate(system:put_char/2,176,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put_char,2]), call_c('Pl_Put_Char_2',[],[x(0),x(1)]), proceed]). predicate(system:put_code/1,183,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put_code,1]), call_c('Pl_Put_Code_1',[],[x(0)]), proceed]). predicate(system:put_code/2,187,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put_code,2]), call_c('Pl_Put_Code_2',[],[x(0),x(1)]), proceed]). predicate(system:put_byte/1,194,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put_byte,1]), call_c('Pl_Put_Byte_1',[],[x(0)]), proceed]). predicate(system:put_byte/2,198,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put_byte,2]), call_c('Pl_Put_Byte_2',[],[x(0),x(1)]), proceed]). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/sort.wam�������������������������������������������������������������������0000644�0001750�0001750�00000004545�13021356407�015010� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : sort.pl file_name('/home/diaz/GP/src/BipsPl/sort.pl'). predicate(system:'$use_sort'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:sort/2,44,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sort,2]), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Sort_List_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:msort/2,52,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[msort,2]), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Sort_List_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:keysort/2,60,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[keysort,2]), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Sort_List_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:sort/1,68,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sort,1]), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_value(y(0),0), deallocate, call_c('Pl_Sort_List_1',[],[x(0)]), proceed]). predicate(system:msort/1,76,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[msort,1]), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_value(y(0),0), deallocate, call_c('Pl_Sort_List_1',[],[x(0)]), proceed]). predicate(system:keysort/1,84,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[keysort,1]), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_value(y(0),0), deallocate, call_c('Pl_Sort_List_1',[],[x(0)]), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/arith_inl.pl���������������������������������������������������������������0000644�0001750�0001750�00000006017�13021324543�015611� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : arith_inl.pl * * Descr.: arithmetic (inline) management - defs for meta-call * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_arith_inl'. X is Y :- X is Y. X =:= Y :- X =:= Y. X =\= Y :- X =\= Y. X < Y :- X < Y. X =< Y :- X =< Y. X > Y :- X > Y. X >= Y :- X >= Y. '$arith_eval'(X, Y) :- '$call_c'('Pl_Arith_Eval_2'(X, Y)). succ(X, Y) :- set_bip_name(succ, 2), '$call_c_test'('Pl_Succ_2'(X, Y)). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/t.pl�����������������������������������������������������������������������0000644�0001750�0001750�00000007421�13021324543�014103� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : development only * * File : t.pl * * Descr.: test - Prolog part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * GNU Prolog is free software; you can redistribute it and/or modify it * * under the terms of the GNU General Public License as published by the * * Free Software Foundation; either version 2, or any later version. * * * * GNU Prolog 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. * * 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. * *-------------------------------------------------------------------------*/ /* * You can put your own test code in these files (see DEVELOPMENT) * t.pl (Prolog part) * t_c.c (C part, eg. foreign code or C code used by your FD constraints) * t_fd.fd (FD constraint part) */ /* ind(X) :- fd_min(X, Min), X #= Min. ind(X) :- write(back(X)),nl, fd_min(X, Min), X #> Min, ind(X). */ /* %:- initialization(z1). z1:- fd_domain(X,[62,63,64,65,66,67,68,69,70]), fd_size(X,N), write(N), nl, halt. z0:- catch(z, _, write('TOO BIG\n')), halt. z:- Z = [A, B, C, D, E, F, G, H, I, J, K, L], fd_domain_bool(Z), % A ## B ## C. A ## B ## C ## D ## E ## F ## G ## H ## I ## J ## K ## L. */ /* works(L) :- L = [Z1, Z2], fd_domain(L, 10, 99), fd_prime(Z1), cross_sum(Z1, Z2), fd_labeling(L), is_square(Z2) . broken(L) :- L = [Z1, Z2], fd_domain(L, 10, 99), fd_prime(Z1), cross_sum(Z1, Z2), is_square(Z2), fd_labeling(L). cross_sum(X, X) :- X #< 10. cross_sum(X, Y) :- X #> 9, Y1 #= X rem 10, X1 #= X // 10, cross_sum(X1, Z), Y #= Z + Y1. is_square(1). is_square(4). is_square(9). is_square(X) :- Y #>= 1, Y #=< X, X #= Y * Y. */ /* sum([], 0):- statistics. sum([X|L], S1) :- sum(L, S), S1 #= X + S. sum1([], 0):- statistics. sum1([X|L], S1) :- S1 #= X + S, sum1(L, S). p :- length(BL, 10000), sum(BL, _BS), statistics. p1 :- length(BL, 10000), sum1(BL, _BS), statistics. dle(S1, S2, D, SY) :- fd_tell(dist_le(S1, S2, D, SY)). */ /* dle(X) :- fd_tell(foo(X)). */ /* bug(L) :- L=[P1,P2,P3,P4,P6,P7,P8,P9], fd_domain(L,[2,3,5,7]), % uncomment the following line and this works correctly % P2#=7, P4 * (100 * P3 + 10 * P2 + P1 ) #= 1000 * P9 + 100 * P8 + 10 * P7 + P6. */ /* q :- LD = [S, E, N, D], fd_domain(LD, 0, 4), fd_all_different(LD), S + 3 * E #= U, U #= 5 * N + D, % S=0, write(LD1), nl, % E=3, write(LD1), nl, % E=2 ne marche pas + remettre optim2 + SEH dans chkma % N=1, write(LD), nl, fd_labeling(LD), write(LD), nl. a:- q, fail ; true. :- initialization(a). */ �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/g_var_inl.pl���������������������������������������������������������������0000644�0001750�0001750�00000006665�13021324543�015611� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : g_var_inl.pl * * Descr.: global variable (inline) management - defs for meta-call * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_g_var_inl'. g_assign(Var, Value) :- g_assign(Var, Value). g_assignb(Var, Value) :- g_assignb(Var, Value). g_link(Var, Value) :- g_link(Var, Value). g_read(Var, Value) :- g_read(Var, Value). g_array_size(Var, Type) :- g_array_size(Var, Type). g_inc(X) :- g_inc(X). g_inco(X, Y) :- g_inco(X, Y). g_inc(X, Y) :- g_inc(X, Y). g_inc(X, Y, Z) :- g_inc(X, Y, Z). g_dec(X) :- g_dec(X). g_deco(X, Y) :- g_deco(X, Y). g_dec(X, Y) :- g_dec(X, Y). g_dec(X, Y, Z) :- g_dec(X, Y, Z). g_set_bit(X, Y) :- g_set_bit(X, Y). g_reset_bit(X, Y) :- g_reset_bit(X, Y). g_test_set_bit(X, Y) :- g_test_set_bit(X, Y). g_test_reset_bit(X, Y) :- g_test_reset_bit(X, Y). ���������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/top_level.wam��������������������������������������������������������������0000644�0001750�0001750�00000067345�13021356407�016021� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : top_level.pl file_name('/home/diaz/GP/src/BipsPl/top_level.pl'). predicate(system:top_level/0,44,static,private,monofile,built_in,[ allocate(6), put_atom(prolog_name,0), put_variable(y(0),1), call(current_prolog_flag/2), put_atom(prolog_version,0), put_variable(y(1),1), call(current_prolog_flag/2), put_atom(prolog_copyright,0), put_variable(y(2),1), call(current_prolog_flag/2), put_atom(address_bits,0), put_variable(y(3),1), call(current_prolog_flag/2), put_atom(compiled_at,0), put_variable(y(4),1), call(current_prolog_flag/2), put_atom(c_cc,0), put_variable(y(5),1), call(current_prolog_flag/2), put_atom(top_level_output,0), put_atom('~N~a ~a (~d bits)~n',1), put_list(2), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_list, unify_local_value(y(3)), unify_nil, call(format/3), put_atom(top_level_output,0), put_atom('Compiled ~a with ~a~n',1), put_list(2), unify_local_value(y(4)), unify_list, unify_local_value(y(5)), unify_nil, call(format/3), put_atom(top_level_output,0), put_atom('By Daniel Diaz',1), call(write/2), call(nl/0), put_atom(top_level_output,0), put_atom('~a~n',1), put_list(2), unify_local_value(y(2)), unify_nil, call(format/3), put_atom('$top_level_cur_module',0), put_atom(user,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, execute(break/0)]). predicate(system:break/0,62,static,private,monofile,built_in,[ allocate(3), call_c('Pl_Set_Ctrl_C_Handler_0',[],[]), put_integer(10,0), put_variable(y(0),1), call('$sys_var_read'/2), put_integer(11,0), put_variable(y(1),1), call('$sys_var_read'/2), put_atom('$all_solutions',0), put_variable(y(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), call('$break/0_$aux1'/1), put_integer(10,0), call('$sys_var_inc'/1), put_atom('$cmd_line_consult_file',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call('$exec_cmd_line_consult_files'/1), put_atom('$cmd_line_entry_goal',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call('$exec_cmd_line_entry_goals'/1), put_atom('$cmd_line_entry_goal',0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), call('$top_level1'/0), put_integer(10,0), call('$sys_var_dec'/1), put_integer(11,0), put_value(y(1),1), call('$sys_var_write'/2), put_atom('$all_solutions',0), put_unsafe_value(y(2),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_unsafe_value(y(0),0), deallocate, execute('$break/0_$aux2'/1)]). predicate(system:'$break/0_$aux2'/1,62,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),2), put_integer(0,3), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(2),x(3)]), cut(x(1)), put_list(2), unify_local_value(x(0)), unify_nil, put_atom(top_level_output,0), put_atom('~N{End Break}~n',1), execute(format/3), label(1), trust_me_else_fail, proceed]). predicate(system:'$break/0_$aux1'/1,62,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),2), put_integer(0,3), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(2),x(3)]), cut(x(1)), put_list(2), unify_local_value(x(0)), unify_nil, put_atom(top_level_output,0), put_atom('~N{Break Level ~d}~n',1), execute(format/3), label(1), trust_me_else_fail, proceed]). predicate(system:'$top_level1'/0,89,static,private,monofile,built_in,[ pragma_arity(1), get_current_choice(x(0)), allocate(1), get_variable(y(0),0), call(repeat/0), put_atom('$top_level_cur_module',0), put_variable(x(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_structure('$top_level_exception'/1,2), unify_variable(x(1)), put_atom('$top_level2',0), put_atom(top_level,4), put_integer(0,5), call('$catch_no_debug'/6), cut(y(0)), deallocate, proceed]). predicate(system:'$top_level_abort'/0,97,static,private,monofile,built_in,[ allocate(1), call('$reinit_after_exception'/0), put_integer(11,0), put_variable(y(0),1), call('$sys_var_read'/2), put_atom(top_level_output,0), put_atom('execution aborted\n',1), call(write/2), put_unsafe_value(y(0),0), deallocate, execute('$catch_sync_for_fail_at'/1)]). predicate(system:'$top_level_stop'/0,106,static,private,monofile,built_in,[ allocate(1), call('$reinit_after_exception'/0), put_integer(11,0), put_variable(y(0),1), call('$sys_var_read'/2), put_unsafe_value(y(0),0), deallocate, execute('$catch_sync_for_fail_at'/1)]). predicate(system:'$top_level_exception'/1,114,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_structure('$post_query_exception'/1,0), unify_variable(y(0)), get_variable(y(1),1), call('$reinit_after_exception'/0), cut(y(1)), put_atom(top_level_output,0), put_atom('~Ntop-level exception: ',1), put_nil(2), call(format/3), put_atom(top_level_output,0), put_value(y(0),1), put_structure(quoted/1,5), unify_atom(true), put_structure(numbervars/1,4), unify_atom(false), put_structure(namevars/1,3), unify_atom(false), put_list(2), unify_value(x(5)), unify_list, unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, call(write_term/3), put_atom(top_level_output,0), call(nl/1), fail, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),0), call('$reinit_after_exception'/0), put_atom(top_level_output,0), put_atom('~Nuncaught exception: ',1), put_nil(2), call(format/3), put_atom(top_level_output,0), put_value(y(0),1), put_structure(quoted/1,5), unify_atom(true), put_structure(numbervars/1,4), unify_atom(false), put_structure(namevars/1,3), unify_atom(false), put_list(2), unify_value(x(5)), unify_list, unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, call(write_term/3), put_atom(top_level_output,0), call(nl/1), fail]). predicate(system:'$reinit_after_exception'/0,132,static,private,monofile,built_in,[ execute('$$reinit_after_exception/0_$aux1'/0)]). predicate(system:'$$reinit_after_exception/0_$aux1'/0,132,static,private,monofile,local,[ pragma_arity(1), get_current_choice(x(0)), try_me_else(1), allocate(1), get_variable(y(0),0), put_integer(12,0), put_integer(1,1), call('$sys_var_read'/2), cut(y(0)), put_atom('$user_prompt',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), deallocate, execute('$set_linedit_prompt'/1), label(1), trust_me_else_fail, proceed]). predicate(system:'$top_level2'/0,144,static,private,monofile,built_in,[ pragma_arity(1), get_current_choice(x(0)), allocate(6), get_variable(y(0),0), call(repeat/0), put_variable(y(1),0), call('$get_current_B'/1), put_integer(11,0), put_value(y(1),1), call('$sys_var_write'/2), call('$write_indicator'/0), put_atom('| ?- ',1), put_variable(y(2),0), call('$$top_level2/0_$aux1'/2), put_atom(top_level_output,0), call(flush_output/1), put_variable(y(3),0), put_variable(y(4),1), call('$read_query'/2), put_value(y(2),0), call('$$top_level2/0_$aux2'/1), put_value(y(4),0), put_variable(y(5),1), call(sort/2), put_unsafe_value(y(3),0), put_unsafe_value(y(0),1), put_unsafe_value(y(5),2), deallocate, execute('$$top_level2/0_$aux3'/3)]). predicate(system:'$$top_level2/0_$aux3'/3,144,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),1), put_atom(end_of_file,1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), cut(x(3)), put_atom(top_level_output,0), call(nl/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, allocate(6), get_variable(y(0),0), get_variable(y(1),2), put_variable(y(2),0), call(user_time/1), put_value(y(0),0), put_value(y(1),1), put_variable(y(3),2), call('$$top_level2/0_$aux4'/3), put_variable(y(4),0), call(user_time/1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(y(4),0), math_load_value(y(2),1), call_c('Pl_Fct_Sub',[fast_call,x(0)],[x(0),x(1)]), get_variable(y(5),0), put_atom(top_level_output,0), put_atom('~N~n',1), put_nil(2), call(format/3), put_value(y(5),0), call('$$top_level2/0_$aux5'/1), put_atom(top_level_output,0), put_atom('~a~n',1), put_list(2), unify_local_value(y(3)), unify_nil, call(format/3), fail]). predicate(system:'$$top_level2/0_$aux5'/1,144,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_integer(0,0), cut(x(1)), proceed, label(1), trust_me_else_fail, put_list(2), unify_local_value(x(0)), unify_nil, put_atom(top_level_output,0), put_atom('(~d ms) ',1), execute(format/3)]). predicate(system:'$$top_level2/0_$aux4'/3,144,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(y(1),3), call('$exec_query'/2), cut(y(1)), put_value(y(0),0), get_atom(yes,0), deallocate, proceed, label(1), trust_me_else_fail, get_atom(no,2), proceed]). predicate(system:'$$top_level2/0_$aux2'/1,144,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_integer(12,0), put_integer(1,1), call('$sys_var_read'/2), cut(y(1)), put_value(y(0),0), deallocate, execute('$set_linedit_prompt'/1), label(1), trust_me_else_fail, proceed]). predicate(system:'$$top_level2/0_$aux1'/2,144,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_integer(12,0), put_integer(1,1), call('$sys_var_read'/2), cut(y(2)), put_value(y(0),0), call('$get_linedit_prompt'/1), put_atom('$user_prompt',0), put_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(1),0), deallocate, execute('$set_linedit_prompt'/1), label(1), trust_me_else_fail, put_atom(top_level_output,0), execute(write/2)]). predicate(system:'$write_indicator'/0,190,static,private,monofile,built_in,[ try_me_else(1), allocate(2), put_atom('$debug_mode',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_variable(y(0),1), call('$dbg_indicator'/2), put_integer(10,0), put_variable(y(1),1), call('$sys_var_read'/2), put_value(y(1),0), put_value(y(0),1), call('$$write_indicator/0_$aux1'/2), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$$write_indicator/0_$aux1'/2,190,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_variable(x(3),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),1), put_integer(1,4), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(1),x(4)]), cut(x(2)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(0),0), call_c('Pl_Fct_Dec',[fast_call,x(1)],[x(0)]), put_value(x(3),0), execute('$$write_indicator/0_$aux2'/2), label(1), retry_me_else(2), get_atom('',1), cut(x(2)), proceed, label(2), trust_me_else_fail, put_list(2), unify_local_value(x(1)), unify_nil, put_atom(top_level_output,0), put_atom('{~a}~n',1), execute(format/3)]). predicate(system:'$$write_indicator/0_$aux2'/2,190,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom('',0), cut(x(2)), put_list(2), unify_local_value(x(1)), unify_nil, put_atom(top_level_output,0), put_atom('{~d}~n',1), execute(format/3), label(1), trust_me_else_fail, put_list(2), unify_local_value(x(0)), unify_list, unify_local_value(x(1)), unify_nil, put_atom(top_level_output,0), put_atom('{~a,~d}~n',1), execute(format/3)]). predicate(system:'$dbg_indicator'/2,211,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(trace,3),(debug,5),(nodebug,7)]), label(2), try_me_else(4), label(3), get_atom(trace,0), get_atom(trace,1), proceed, label(4), retry_me_else(6), label(5), get_atom(debug,0), get_atom(debug,1), proceed, label(6), trust_me_else_fail, label(7), get_atom(nodebug,0), get_atom('',1), proceed]). predicate(system:'$read_query'/2,220,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_integer(10,0), put_integer(1,1), call('$sys_var_read'/2), put_atom('$cmd_line_query_goal',0), put_list(2), unify_variable(y(3)), unify_variable(x(1)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), put_atom('$cmd_line_query_goal',0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), cut(y(2)), put_atom('| ?- ',0), call('$$read_query/2_$aux1'/1), put_atom(top_level_output,0), put_atom('~a.~n',1), put_list(2), unify_value(y(3)), unify_nil, call(format/3), put_value(y(3),0), put_value(y(0),1), put_structure(end_of_term/1,4), unify_atom(eof), put_structure(variable_names/1,3), unify_local_value(y(1)), put_list(2), unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, deallocate, execute(read_term_from_atom/3), label(1), trust_me_else_fail, allocate(0), put_structure(variable_names/1,3), unify_local_value(x(1)), put_list(2), unify_value(x(3)), unify_nil, put_value(x(0),1), put_atom(top_level_input,0), call(read_term/3), put_atom(top_level_input,0), deallocate, execute('$PB_empty_buffer'/1)]). predicate(system:'$$read_query/2_$aux1'/1,220,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_integer(12,0), put_integer(1,1), call('$sys_var_read'/2), cut(y(1)), put_atom(top_level_output,0), put_value(y(0),1), deallocate, execute(write/2), label(1), trust_me_else_fail, proceed]). predicate(system:'$exec_query'/2,239,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), put_atom('$debug_mode',0), put_variable(x(1),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), put_atom('$debug_next',0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$all_solutions',0), put_atom(f,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_variable(y(2),0), call('$get_current_B'/1), call_c('Pl_Save_Regs_For_Signal',[],[]), put_atom('$top_level_cur_module',0), put_variable(y(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(3),1), put_atom(top_level,2), put_integer(0,3), call('$call'/4), call_c('Pl_Save_Regs_For_Signal',[],[]), put_variable(y(4),0), call('$get_current_B'/1), put_atom(top_level_output,0), put_atom('~N',1), put_nil(2), call(format/3), put_structure(throw/1,2), unify_structure('$post_query_exception'/1), unify_variable(x(1)), put_structure('$set_query_vars_names'/2,0), unify_local_value(y(1)), unify_variable(y(5)), put_value(y(3),3), put_atom(top_level,4), put_integer(0,5), call('$catch_no_debug'/6), put_value(y(5),0), put_unsafe_value(y(4),1), put_unsafe_value(y(2),2), deallocate, execute('$$exec_query/2_$aux1'/3)]). predicate(system:'$$exec_query/2_$aux1'/3,239,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),0), get_variable(y(1),3), fail, label(1), trust_me_else_fail, allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_value(y(0),1), put_value(y(1),2), call('$write_solution'/3), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$$exec_query/2_$aux2'/2)]). predicate(system:'$$exec_query/2_$aux2'/2,239,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), put_atom('$all_solutions',0), put_atom(f,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom(top_level_output,0), put_atom(' ? ',1), call(write/2), deallocate, execute('$read_return'/0), label(1), trust_me_else_fail, proceed]). predicate(system:'$set_query_vars_names'/2,270,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), put_variable(y(2),1), call(name_query_vars/2), put_value(y(2),0), put_value(y(1),1), call('$remove_underscore_vars'/2), put_value(y(1),0), call(name_singleton_vars/1), put_value(y(1),0), put_structure(exclude/1,2), unify_local_value(y(0)), put_list(1), unify_value(x(2)), unify_list, unify_atom(namevars), unify_nil, deallocate, execute(bind_variables/2)]). predicate(system:'$remove_underscore_vars'/2,279,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_nil(1), proceed, label(4), retry_me_else(6), label(5), allocate(3), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure((=)/2,0), unify_variable(x(0)), unify_variable(x(1)), get_variable(y(2),2), call('$$remove_underscore_vars/2_$aux1'/2), cut(y(2)), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$remove_underscore_vars'/2), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(2)), unify_variable(x(0)), get_list(1), unify_value(x(2)), unify_variable(x(1)), execute('$remove_underscore_vars'/2)]). predicate(system:'$$remove_underscore_vars/2_$aux1'/2,281,static,private,monofile,local,[ try_me_else(1), put_integer(0,1), put_integer(1,2), put_void(3), put_atom('_',4), execute(sub_atom/5), label(1), trust_me_else_fail, get_structure('$VARNAME'/1,1), unify_variable(x(0)), put_integer(0,1), put_integer(1,2), put_void(3), put_atom('_',4), execute(sub_atom/5)]). predicate(system:'$write_solution'/3,294,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_nil(0), cut(x(3)), put_value(x(1),0), put_value(x(2),1), execute('$$write_solution/3_$aux1'/2), label(1), trust_me_else_fail, allocate(3), get_variable(y(0),0), get_variable(y(1),3), put_variable(y(2),0), call('$$write_solution/3_$aux2'/1), cut(y(1)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(y(2),0), call_c('Pl_Fct_Dec',[fast_call,x(1)],[x(0)]), put_value(y(0),0), deallocate, execute('$write_solution1'/2)]). predicate(system:'$$write_solution/3_$aux2'/1,301,static,private,monofile,local,[ try_me_else(1), put_atom(xfx,1), put_atom(=,2), execute(current_op/3), label(1), trust_me_else_fail, get_integer(700,0), proceed]). predicate(system:'$$write_solution/3_$aux1'/2,294,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), put_atom(top_level_output,0), put_atom('~ntrue',1), put_nil(2), execute(format/3), label(1), trust_me_else_fail, proceed]). predicate(system:'$write_solution1'/2,307,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure((=)/2,0), unify_variable(x(1)), unify_variable(x(0)), put_value(y(1),2), call('$$write_solution1/2_$aux1'/3), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$write_solution1'/2)]). predicate(system:'$$write_solution1/2_$aux1'/3,309,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), call(acyclic_term/1), cut(y(3)), put_atom(top_level_output,0), put_atom('~n~a = ',1), put_list(2), unify_local_value(y(1)), unify_nil, call(format/3), put_atom(top_level_output,0), put_value(y(0),1), put_structure(quoted/1,6), unify_atom(true), put_structure(numbervars/1,5), unify_atom(false), put_structure(namevars/1,4), unify_atom(true), put_structure(priority/1,3), unify_local_value(y(2)), put_list(2), unify_value(x(6)), unify_list, unify_value(x(5)), unify_list, unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, deallocate, execute(write_term/3), label(1), trust_me_else_fail, put_list(2), unify_local_value(x(1)), unify_nil, put_atom(top_level_output,0), put_atom('~ncannot display cyclic term for ~a',1), execute(format/3)]). predicate(system:'$read_return'/0,321,static,private,monofile,built_in,[ pragma_arity(1), get_current_choice(x(0)), allocate(2), get_variable(y(0),0), put_atom(top_level_output,0), call(flush_output/1), put_atom(top_level_input,0), put_variable(y(1),1), call(get_key/2), put_value(y(1),0), call('$read_return'/1), cut(y(0)), deallocate, proceed]). predicate(system:'$read_return'/1,329,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(12), switch_on_term(2,fail,1,fail,fail), label(1), switch_on_integer([(10,3),(13,5),(97,7),(59,9),(32,11)]), label(2), try_me_else(4), label(3), get_integer(10,0), proceed, label(4), retry_me_else(6), label(5), get_integer(13,0), proceed, label(6), retry_me_else(8), label(7), get_integer(97,0), put_atom('$all_solutions',0), put_atom(t,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(2)]), cut(x(1)), fail, label(8), retry_me_else(10), label(9), allocate(1), get_integer(59,0), get_variable(y(0),1), put_atom(top_level_output,0), put_atom('~N',1), put_nil(2), call(format/3), cut(y(0)), fail, label(10), trust_me_else_fail, label(11), allocate(1), get_integer(32,0), get_variable(y(0),1), put_atom(top_level_output,0), put_atom('\b;~N',1), put_nil(2), call(format/3), cut(y(0)), fail, label(12), trust_me_else_fail, allocate(0), put_atom(top_level_output,0), call(nl/1), put_atom(top_level_output,0), put_atom('Action (; for next solution, a for all solutions, RET to stop) ? ',1), call(write/2), deallocate, execute('$read_return'/0)]). predicate(system:'$exec_cmd_line_consult_files'/1,354,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(6), switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), allocate(2), get_list(0), unify_variable(y(0)), unify_void(1), put_structure('$consult2'/2,0), unify_value(y(0)), unify_atom(user), put_structure(error/2,1), unify_variable(y(1)), unify_void(1), put_atom(true,2), put_atom(system,3), put_atom('command-line',4), put_integer(-1,5), call('$catch_no_debug'/6), put_value(y(1),0), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_atom('~Nwarning: command-line consulting file ~q failed due to ~q~n',0), put_list(1), unify_value(y(0)), unify_list, unify_value(y(1)), unify_nil, call(format/2), fail, label(4), trust_me_else_fail, label(5), get_list(0), unify_void(1), unify_variable(x(0)), cut(x(1)), execute('$exec_cmd_line_consult_files'/1), label(6), trust_me_else_fail, proceed]). predicate(system:'$exec_cmd_line_entry_goals'/1,369,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(1)), call('$exec_cmd_line_goal'/1), put_value(y(0),0), deallocate, execute('$exec_cmd_line_entry_goals'/1), label(1), trust_me_else_fail, proceed]). predicate(system:'$exec_cmd_line_goal'/1,379,static,private,monofile,built_in,[ execute('$$exec_cmd_line_goal/1_$aux1'/1)]). predicate(system:'$$exec_cmd_line_goal/1_$aux1'/1,379,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_variable(x(3),0), get_variable(y(0),1), put_structure('$exec_cmd1'/1,0), unify_local_value(x(3)), put_structure('$exec_cmd_err'/2,2), unify_local_value(x(3)), unify_variable(x(1)), put_atom(user,3), put_atom('command-line',4), put_integer(-1,5), call('$catch_no_debug'/6), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_list(1), unify_local_value(x(0)), unify_nil, put_atom('~Nwarning: command-line goal ~q failed~n',0), execute(format/2)]). predicate(system:'$exec_cmd1'/1,385,static,private,monofile,built_in,[ allocate(1), put_variable(y(0),1), put_structure(end_of_term/1,3), unify_atom(eof), put_list(2), unify_value(x(3)), unify_nil, call(read_term_from_atom/3), put_unsafe_value(y(0),0), put_atom(user,1), put_atom('command-line',2), put_integer(-1,3), deallocate, execute('$call'/4)]). predicate(system:'$exec_cmd_err'/2,390,static,private,monofile,built_in,[ get_variable(x(2),1), put_list(1), unify_local_value(x(0)), unify_list, unify_local_value(x(2)), unify_nil, put_atom('~Nwarning: command-line goal ~q caused exception: ~q~n',0), execute(format/2)]). ensure_linked([consult/1,load/1]). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/oper.wam�������������������������������������������������������������������0000644�0001750�0001750�00000004010�13021356407�014751� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : oper.pl file_name('/home/diaz/GP/src/BipsPl/oper.pl'). predicate(system:'$use_oper'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:op/3,43,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[op,3]), put_value(y(2),0), call('$check_atom_or_atom_list'/1), put_value(y(2),0), put_value(y(0),1), put_value(y(1),2), deallocate, execute('$op/3_$aux1'/3)]). predicate(system:'$op/3_$aux1'/3,43,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_variable(x(4),2), get_variable(x(2),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(2)]), cut(x(3)), put_value(x(1),0), put_value(x(4),1), execute('$op2'/3), label(1), trust_me_else_fail, get_variable(x(3),2), get_variable(x(2),1), put_value(x(3),1), execute('$op1'/3)]). predicate(system:'$op1'/3,52,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(3), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(2)), unify_variable(y(0)), put_value(y(2),0), put_value(y(1),1), call('$op2'/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute('$op1'/3)]). predicate(system:'$op2'/3,59,static,private,monofile,built_in,[ call_c('Pl_Op_3',[],[x(0),x(1),x(2)]), proceed]). predicate(system:current_op/3,65,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_op,3]), call_c('Pl_Current_Op_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$current_op_alt'/0,70,static,private,monofile,built_in,[ call_c('Pl_Current_Op_Alt_0',[boolean],[]), proceed]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/const_io_c.c���������������������������������������������������������������0000644�0001750�0001750�00000060031�13021324543�015562� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : const_io_c.c * * Descr.: input/output from/to constant term management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /* from write_c.c */ void Pl_Write_Term_2(WamWord sora_word, WamWord term_word); void Pl_Write_2(WamWord sora_word, WamWord term_word); void Pl_Writeq_2(WamWord sora_word, WamWord term_word); void Pl_Write_Canonical_2(WamWord sora_word, WamWord term_word); void Pl_Display_2(WamWord sora_word, WamWord term_word); void Pl_Print_2(WamWord sora_word, WamWord term_word); /* from format_c.c */ void Pl_Format_3(WamWord sora_word, WamWord format_word, WamWord args_word); /* from read_c.c */ Bool Pl_Read_Term_5(WamWord sora_word, WamWord term_word, WamWord vars_word, WamWord var_names_word, WamWord sing_names_word); Bool Pl_Read_Token_2(WamWord sora_word, WamWord token_word); /*----- OUTPUT -----*/ #define OUT_TO_STR(const_stream_type, str, stm_word, code_out, code_after) \ { \ int stm; \ WamWord stm_word; \ char *str; \ \ stm = Pl_Add_Str_Stream(NULL, const_stream_type); \ stm_word = Pl_Make_Stream_Tagged_Word(stm); \ \ { code_out; } \ \ str = Pl_Term_Write_Str_Stream(stm); \ \ { code_after; } \ \ Pl_Delete_Str_Stream(stm); \ } /*-------------------------------------------------------------------------* * PL_WRITE_TO_STRING (foreign interface) * * * *-------------------------------------------------------------------------*/ char * Pl_Write_To_String(WamWord term_word) { char *ret_str; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Write_2(stm_word, term_word), ret_str = Strdup(str)); return ret_str; } /*-------------------------------------------------------------------------* * PL_WRITEQ_TO_STRING (foreign interface) * * * *-------------------------------------------------------------------------*/ char * Pl_Writeq_To_String(WamWord term_word) { char *ret_str; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Writeq_2(stm_word, term_word), ret_str = Strdup(str)); return ret_str; } /*-------------------------------------------------------------------------* * PL_WRITE_CANONICAL_TO_STRING (foreign interface) * * * *-------------------------------------------------------------------------*/ char * Pl_Write_Canonical_To_String(WamWord term_word) { char *ret_str; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Write_Canonical_2(stm_word, term_word), ret_str = Strdup(str)); return ret_str; } /*-------------------------------------------------------------------------* * PL_DISPLAY_TO_STRING (foreign interface) * * * *-------------------------------------------------------------------------*/ char * Pl_Display_To_String(WamWord term_word) { char *ret_str; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Display_2(stm_word, term_word), ret_str = Strdup(str)); return ret_str; } /*-------------------------------------------------------------------------* * PL_WRITE_TO_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_To_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Write_2(stm_word, term_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_TO_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_To_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Write_2(stm_word, term_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_TO_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_To_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Write_2(stm_word, term_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITEQ_TO_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Writeq_To_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Writeq_2(stm_word, term_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITEQ_TO_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Writeq_To_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Writeq_2(stm_word, term_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITEQ_TO_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Writeq_To_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Writeq_2(stm_word, term_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_CANONICAL_TO_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_Canonical_To_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Write_Canonical_2(stm_word, term_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_CANONICAL_TO_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_Canonical_To_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Write_Canonical_2(stm_word, term_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_CANONICAL_TO_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_Canonical_To_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Write_Canonical_2(stm_word, term_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*-------------------------------------------------------------------------* * PL_DISPLAY_TO_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Display_To_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Display_2(stm_word, term_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_DISPLAY_TO_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Display_To_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Display_2(stm_word, term_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_DISPLAY_TO_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Display_To_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Display_2(stm_word, term_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*-------------------------------------------------------------------------* * PL_PRINT_TO_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Print_To_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Print_2(stm_word, term_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_PRINT_TO_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Print_To_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Print_2(stm_word, term_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_PRINT_TO_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Print_To_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Print_2(stm_word, term_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_TERM_TO_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_Term_To_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Write_Term_2(stm_word, term_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_TERM_TO_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_Term_To_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Write_Term_2(stm_word, term_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_WRITE_TERM_TO_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Write_Term_To_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Write_Term_2(stm_word, term_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*-------------------------------------------------------------------------* * PL_FORMAT_TO_ATOM_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Format_To_Atom_3(WamWord atom_word, WamWord format_word, WamWord args_word) { Bool ret; OUT_TO_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Format_3(stm_word, format_word, args_word), ret = Pl_Un_String_Check(str, atom_word)); return ret; } /*-------------------------------------------------------------------------* * PL_FORMAT_TO_CHARS_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Format_To_Chars_3(WamWord chars_word, WamWord format_word, WamWord args_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CHARS, str, stm_word, Pl_Format_3(stm_word, format_word, args_word), ret = Pl_Un_Chars_Check(str, chars_word)); return ret; } /*-------------------------------------------------------------------------* * PL_FORMAT_TO_CODES_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Format_To_Codes_3(WamWord codes_word, WamWord format_word, WamWord args_word) { Bool ret; OUT_TO_STR(TERM_STREAM_CODES, str, stm_word, Pl_Format_3(stm_word, format_word, args_word), ret = Pl_Un_Codes_Check(str, codes_word)); return ret; } /*----- INPUT -----*/ #define IN_FROM_STR(const_stream_type, str, stm_word, code_in) \ { \ int stm; \ WamWord stm_word; \ \ stm = Pl_Add_Str_Stream(str, const_stream_type); \ stm_word = Pl_Make_Stream_Tagged_Word(stm); \ \ { code_in; } \ \ Pl_Delete_Str_Stream(stm); \ } /*-------------------------------------------------------------------------* * PL_READ_FROM_STRING (foreign interface) * * * *-------------------------------------------------------------------------*/ WamWord Pl_Read_From_String(char *str) { WamWord term_word = Pl_Mk_Variable(); /* this corresponds to defaults in read.pl ('$set_read_defaults') and read_c.c */ SYS_VAR_OPTION_MASK = 0; /* nothing */ SYS_VAR_OPTION_MASK |= (1 << 3); /* end_of_term = EOF */ SYS_VAR_SYNTAX_ERROR_ACTON = -1; /* on syntax error use value fo flags syntax_error */ IN_FROM_STR(TERM_STREAM_ATOM, str, stm_word, Pl_Read_Term_5(stm_word, term_word, 0, 0, 0)); return term_word; } /*-------------------------------------------------------------------------* * PL_READ_FROM_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_From_Atom_2(WamWord atom_word, WamWord term_word) { Bool ret; IN_FROM_STR(TERM_STREAM_ATOM, pl_atom_tbl[Pl_Rd_Atom_Check(atom_word)].name, stm_word, ret = Pl_Read_Term_5(stm_word, term_word, 0, 0, 0)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_FROM_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_From_Chars_2(WamWord chars_word, WamWord term_word) { Bool ret; IN_FROM_STR(TERM_STREAM_CHARS, Pl_Rd_Chars_Check(chars_word), stm_word, ret = Pl_Read_Term_5(stm_word, term_word, 0, 0, 0)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_FROM_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_From_Codes_2(WamWord codes_word, WamWord term_word) { Bool ret; IN_FROM_STR(TERM_STREAM_CODES, Pl_Rd_Codes_Check(codes_word), stm_word, ret = Pl_Read_Term_5(stm_word, term_word, 0, 0, 0)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_TERM_FROM_ATOM_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Term_From_Atom_5(WamWord atom_word, WamWord term_word, WamWord vars_word, WamWord var_names_word, WamWord sing_names_word) { Bool ret; IN_FROM_STR(TERM_STREAM_ATOM, pl_atom_tbl[Pl_Rd_Atom_Check(atom_word)].name, stm_word, ret = Pl_Read_Term_5(stm_word, term_word, vars_word, var_names_word, sing_names_word)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_TERM_FROM_CHARS_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Term_From_Chars_5(WamWord chars_word, WamWord term_word, WamWord vars_word, WamWord var_names_word, WamWord sing_names_word) { Bool ret; IN_FROM_STR(TERM_STREAM_CHARS, Pl_Rd_Chars_Check(chars_word), stm_word, ret = Pl_Read_Term_5(stm_word, term_word, vars_word, var_names_word, sing_names_word)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_TERM_FROM_CODES_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Term_From_Codes_5(WamWord codes_word, WamWord term_word, WamWord vars_word, WamWord var_names_word, WamWord sing_names_word) { Bool ret; IN_FROM_STR(TERM_STREAM_CODES, Pl_Rd_Codes_Check(codes_word), stm_word, ret = Pl_Read_Term_5(stm_word, term_word, vars_word, var_names_word, sing_names_word)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_TOKEN_FROM_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Token_From_Atom_2(WamWord atom_word, WamWord token_word) { Bool ret; IN_FROM_STR(TERM_STREAM_ATOM, pl_atom_tbl[Pl_Rd_Atom_Check(atom_word)].name, stm_word, ret = Pl_Read_Token_2(stm_word, token_word)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_TOKEN_FROM_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Token_From_Chars_2(WamWord chars_word, WamWord token_word) { Bool ret; IN_FROM_STR(TERM_STREAM_CHARS, Pl_Rd_Chars_Check(chars_word), stm_word, ret = Pl_Read_Token_2(stm_word, token_word)); return ret; } /*-------------------------------------------------------------------------* * PL_READ_TOKEN_FROM_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Token_From_Codes_2(WamWord codes_word, WamWord token_word) { Bool ret; IN_FROM_STR(TERM_STREAM_CODES, Pl_Rd_Codes_Check(codes_word), stm_word, ret = Pl_Read_Token_2(stm_word, token_word)); return ret; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/flag_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000057055�13021324543�014672� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : flag_c.c * * Descr.: Prolog flag and system variable management - C Part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #define OBJ_INIT Flag_Initializer #define FLAG_C_FILE #include "engine_pl.h" #include "gprolog_cst.h" #include "bips_pl.h" #ifndef _WIN32 #include <unistd.h> extern char **environ; #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int type; int prec; int left; int right; int length; } SFOp; /*---------------------------------* * Global Variables * *---------------------------------*/ static int atom_on; static int atom_the_dialect; static int atom_the_cc; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Fct_Set_Debug(FlagInf *flag, WamWord value_word); static WamWord Fct_Get_Version_Data(FlagInf *flag); static Bool Fct_Chk_Version_Data(FlagInf *flag, WamWord tag_mask, WamWord value_word); static WamWord Fct_Get_Argv(FlagInf *flag); static Bool Fct_Chk_Argv(FlagInf *flag, WamWord tag_mask, WamWord value_word); #define ENVIRON_ALT X1_24656E7669726F6E5F616C74 Prolog_Prototype(ENVIRON_ALT, 0); /*-------------------------------------------------------------------------* * FLAG_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Flag_Initializer(void) { Bool is_unix = FALSE; #if defined(__unix__) || defined(__CYGWIN__) || defined(unix) is_unix = TRUE; #endif atom_on = Pl_Create_Atom("on"); atom_the_dialect = Pl_Create_Atom(PROLOG_DIALECT); atom_the_cc = Pl_Create_Atom(CC); /* Unchangeable flags */ NEW_FLAG_ATOM (prolog_name, PROLOG_NAME); NEW_FLAG_ATOM (prolog_version, PROLOG_VERSION); NEW_FLAG_ATOM (prolog_date, PROLOG_DATE); NEW_FLAG_ATOM (prolog_copyright, PROLOG_COPYRIGHT); NEW_FLAG_ATOM (dialect, PROLOG_DIALECT); NEW_FLAG_INTEGER(version, __GPROLOG_VERSION__); Pl_New_Prolog_Flag("version_data", FALSE, PF_TYPE_ANY, 0, Fct_Get_Version_Data, Fct_Chk_Version_Data, NULL); NEW_FLAG_BOOL (bounded, TRUE); NEW_FLAG_INTEGER(max_integer, INT_GREATEST_VALUE); NEW_FLAG_INTEGER(min_integer, INT_LOWEST_VALUE); NEW_FLAG_ROUND (integer_rounding_function, ((-3 / 2) == -1) ? PF_ROUND_ZERO : PF_ROUND_DOWN); NEW_FLAG_INTEGER(max_arity, MAX_ARITY); NEW_FLAG_INTEGER(max_atom, pl_max_atom); NEW_FLAG_INTEGER(max_unget, STREAM_PB_SIZE); NEW_FLAG_ATOM (home, pl_home ? pl_home : ""); NEW_FLAG_ATOM (host_os, M_OS); NEW_FLAG_ATOM (host_vendor, M_VENDOR); NEW_FLAG_ATOM (host_cpu, M_CPU); NEW_FLAG_ATOM (host, M_CPU "-" M_VENDOR "-" M_OS); NEW_FLAG_ATOM (arch, M_CPU "-" M_OS); NEW_FLAG_INTEGER(address_bits, WORD_SIZE); NEW_FLAG_BOOL (unix, is_unix); NEW_FLAG_ATOM (compiled_at, COMPILED_AT); /* see arch_dep.h */ NEW_FLAG_ATOM (c_cc, CC); Pl_New_Prolog_Flag("c_cc_version_data", FALSE, PF_TYPE_ANY, 1, Fct_Get_Version_Data, Fct_Chk_Version_Data, NULL); NEW_FLAG_ATOM (c_cflags, CFLAGS_MACHINE " " CFLAGS); NEW_FLAG_ATOM (c_ldflags, LDFLAGS); Pl_New_Prolog_Flag("argv", FALSE, PF_TYPE_ANY, 0, Fct_Get_Argv, Fct_Chk_Argv, NULL); /* changeable flags */ NEW_FLAG_ON_OFF (char_conversion, 0); NEW_FLAG_ON_OFF (singleton_warning, 1); NEW_FLAG_ON_OFF (suspicious_warning, 1); NEW_FLAG_ON_OFF (multifile_warning, 1); NEW_FLAG_ON_OFF (strict_iso, 1); #if 0 NEW_FLAG_ON_OFF (debug, 0); #else /* to have a customized Set function */ pl_flag_debug = Pl_New_Prolog_Flag("debug", TRUE, PF_TYPE_ON_OFF, 0, NULL, NULL, Fct_Set_Debug); #endif NEW_FLAG_QUOTES(double_quotes, PF_QUOT_AS_CODES); /* DON'T CHANGE back_quotes default: no_escape is useful under * Windows when assoc .pl to gprolog (see InnoSetup) and avoid \ (backslash) * to be misinterpreted in pathnames (e.g. c:\foo\bar). */ NEW_FLAG_QUOTES(back_quotes, PF_QUOT_AS_ATOM | PF_QUOT_NO_ESCAPE_MASK); NEW_FLAG_ERR (unknown, PF_ERR_ERROR); NEW_FLAG_ERR (syntax_error, PF_ERR_ERROR); NEW_FLAG_ERR (os_error, PF_ERR_ERROR); SYS_VAR_LINEDIT = pl_stream_use_linedit; } /*-------------------------------------------------------------------------* * FCT_SET_DEBUG * * * *-------------------------------------------------------------------------*/ static Bool Fct_Set_Debug(FlagInf *flag, WamWord value_word) { int atom = UnTag_ATM(value_word); PlLong value = (atom == atom_on); PredInf *pred; if (!SYS_VAR_DEBUGGER) return value == 0; pred = Pl_Lookup_Pred(pl_atom_system, Pl_Create_Atom(value ? "debug" : "nodebug"), 0); if (pred != NULL) Pl_Call_Prolog((CodePtr) (pred->codep)); else value = 0; /* should not occurs */ flag->value = value; return TRUE; } /*-------------------------------------------------------------------------* * FCT_GET_VERSION_DATA FCT_CHK_VERSION_DATA * * * *-------------------------------------------------------------------------*/ static WamWord Fct_Get_Version_Data(FlagInf *flag) { int atom; int major, minor, patchlevel; WamWord value_word; if (flag->value == 0) /* GNU Prolog version */ { atom = atom_the_dialect; major = __GPROLOG__; minor = __GPROLOG_MINOR__; patchlevel = __GPROLOG_PATCHLEVEL__; } else /* C compiler version */ { atom = atom_the_cc; major = CC_MAJOR; minor = CC_MINOR; patchlevel = CC_PATCHLEVEL; } value_word = Pl_Put_Structure(atom, 4); Pl_Unify_Integer(major); Pl_Unify_Integer(minor); Pl_Unify_Integer(patchlevel); Pl_Unify_Nil(); return value_word; } static Bool Fct_Chk_Version_Data(FlagInf *flag, WamWord tag_mask, WamWord value_word) { int atom; WamWord *adr; if (tag_mask != TAG_STC_MASK) return FALSE; if (flag->value == 0) /* GNU Prolog version */ atom = atom_the_dialect; else /* C compiler version */ atom = atom_the_cc; adr = UnTag_STC(value_word); return Functor(adr) == atom && Arity(adr) == 4; } /*-------------------------------------------------------------------------* * FCT_GET_ARGV FCT_CHK_ARGV * * * *-------------------------------------------------------------------------*/ static WamWord Fct_Get_Argv(FlagInf *flag) { WamWord value_word, word; int i; value_word = word = Pl_Put_X_Variable(); for (i = 0; i < pl_os_argc; i++) { Pl_Get_List(word); Pl_Unify_Atom(Pl_Create_Atom(pl_os_argv[i])); word = Pl_Unify_Variable(); } Pl_Get_Nil(word); return value_word; } static Bool Fct_Chk_Argv(FlagInf *flag, WamWord tag_mask, WamWord value_word) { return (tag_mask == TAG_LST_MASK || value_word == NIL_WORD); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_WRITE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Sys_Var_Write_2(WamWord var_word, WamWord n_word) { pl_sys_var[Pl_Rd_Integer(var_word)] = Pl_Rd_Integer(n_word); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_READ_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sys_Var_Read_2(WamWord var_word, WamWord n_word) { return Pl_Get_Integer(pl_sys_var[Pl_Rd_Integer(var_word)], n_word); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_INC_1 * * * *-------------------------------------------------------------------------*/ void Pl_Sys_Var_Inc_1(WamWord var_word) { pl_sys_var[Pl_Rd_Integer(var_word)]++; } /*-------------------------------------------------------------------------* * PL_SYS_VAR_DEC_1 * * * *-------------------------------------------------------------------------*/ void Pl_Sys_Var_Dec_1(WamWord var_word) { pl_sys_var[Pl_Rd_Integer(var_word)]--; } /*-------------------------------------------------------------------------* * PL_SYS_VAR_SET_BIT_2 * * * *-------------------------------------------------------------------------*/ void Pl_Sys_Var_Set_Bit_2(WamWord var_word, WamWord bit_word) { pl_sys_var[Pl_Rd_Integer(var_word)] |= (1 << Pl_Rd_Integer(bit_word)); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_RESET_BIT_2 * * * *-------------------------------------------------------------------------*/ void Pl_Sys_Var_Reset_Bit_2(WamWord var_word, WamWord bit_word) { pl_sys_var[Pl_Rd_Integer(var_word)] &= ~(1 << Pl_Rd_Integer(bit_word)); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_SET_BIT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sys_Var_Get_Bit_3(WamWord var_word, WamWord bit_word, WamWord value_word) { unsigned x; x = (pl_sys_var[Pl_Rd_Integer(var_word)] >> Pl_Rd_Integer(bit_word)) & 1; return Pl_Un_Integer(x, value_word); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_PUT_2 * * * *-------------------------------------------------------------------------*/ void Pl_Sys_Var_Put_2(WamWord var_word, WamWord term_word) { WamWord word, tag_mask; WamWord *adr; int sv; int size; sv = Pl_Rd_Integer(var_word); word = pl_sys_var[sv]; tag_mask = Tag_Mask_Of(word); if (tag_mask == TAG_REF_MASK) { adr = UnTag_REF(word); if (adr != NULL) Free(adr); /* recover the Malloc: don't mix sys_var_put/get and others sys_var_write... on same sys variable */ } DEREF(term_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK || tag_mask == TAG_INT_MASK) { pl_sys_var[sv] = word; return; } size = Pl_Term_Size(word); adr = (WamWord *) Malloc(size * sizeof(WamWord)); /* recovered at next sys_var_put */ Pl_Copy_Term(adr, &word); pl_sys_var[sv] = Tag_REF(adr); } /*-------------------------------------------------------------------------* * PL_SYS_VAR_GET_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sys_Var_Get_2(WamWord var_word, WamWord term_word) { WamWord word; WamWord *adr; int size; word = pl_sys_var[Pl_Rd_Integer(var_word)]; if (Tag_Mask_Of(word) == TAG_REF_MASK) { adr = UnTag_REF(word); size = Pl_Term_Size(*adr); Pl_Copy_Contiguous_Term(H, adr); word = *H; H += size; } return Pl_Unify(word, term_word); } /*-------------------------------------------------------------------------* * PL_GET_CURRENT_B_1 * * * *-------------------------------------------------------------------------*/ void Pl_Get_Current_B_1(WamWord b_word) { WamWord word; word = Pl_Get_Current_Choice(); Pl_Unify(word, b_word); } /*-------------------------------------------------------------------------* * PL_SET_CURRENT_B_1 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Current_B_1(WamWord b_word) { WamWord word, tag_mask; DEREF(b_word, word, tag_mask); Pl_Cut(word); } /*-------------------------------------------------------------------------* * PL_WRITE_PL_STATE_FILE * * * *-------------------------------------------------------------------------*/ /* these macros are to avoid gcc warning warn_unused_result */ #define FWRITE(b, sz, n, f) if (fwrite(b, sz, n, f) != n) {} #define FREAD(b, sz, n, f) if (fread(b, sz, n, f) != n) {} Bool Pl_Write_Pl_State_File(WamWord file_word) { char *file; FILE *f; int i; HashScan scan; OperInf *oper; SFOp sf_op; int c; /* 'static' is because gcc allocates a frame even with -fomit-frame-pointer. * This corrupts ebp on ix86 */ static char cv[2]; file = pl_atom_tbl[Pl_Rd_Atom_Check(file_word)].name; file = Pl_M_Absolute_Path_Name(file); f = fopen(file, "wb"); Os_Test_Error_Null(f); i = Pl_Hash_Nb_Elements(pl_oper_tbl); FWRITE(&i, sizeof(i), 1, f); for (oper = (OperInf *) Pl_Hash_First(pl_oper_tbl, &scan); oper; oper = (OperInf *) Pl_Hash_Next(&scan)) { sf_op.type = Type_Of_Oper(oper->a_t); sf_op.prec = oper->prec; sf_op.left = oper->left; sf_op.right = oper->right; sf_op.length = pl_atom_tbl[Atom_Of_Oper(oper->a_t)].prop.length; FWRITE(&sf_op, sizeof(sf_op), 1, f); FWRITE(pl_atom_tbl[Atom_Of_Oper(oper->a_t)].name, sf_op.length, 1, f); } i = Flag_Value(double_quotes); FWRITE(&i, sizeof(i), 1, f); i = Flag_Value(back_quotes); FWRITE(&i, sizeof(i), 1, f); i = Flag_Value(char_conversion); FWRITE(&i, sizeof(i), 1, f); i = Flag_Value(singleton_warning); FWRITE(&i, sizeof(i), 1, f); i = Flag_Value(suspicious_warning); FWRITE(&i, sizeof(i), 1, f); i = Flag_Value(multifile_warning); FWRITE(&i, sizeof(i), 1, f); i = Flag_Value(strict_iso); FWRITE(&i, sizeof(i), 1, f); i = SYS_VAR_SAY_GETC; FWRITE(&i, sizeof(i), 1, f); for (c = 0; c < 256; c++) if (pl_char_conv[c] != c) { cv[0] = c; cv[1] = pl_char_conv[c]; FWRITE(&cv, 2, 1, f); } cv[0] = 0; cv[1] = 0; FWRITE(&cv, 2, 1, f); fclose(f); return TRUE; } /*-------------------------------------------------------------------------* * PL_READ_PL_STATE_FILE * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Pl_State_File(WamWord file_word) { char *file; FILE *f; int i; SFOp sf_op; int c; char cv[2]; file = pl_atom_tbl[Pl_Rd_Atom_Check(file_word)].name; file = Pl_M_Absolute_Path_Name(file); f = fopen(file, "rb"); Os_Test_Error_Null(f); Pl_Hash_Delete_All(pl_oper_tbl); FREAD(&i, sizeof(i), 1, f); while (i--) { FREAD(&sf_op, sizeof(sf_op), 1, f); FREAD(pl_glob_buff, sf_op.length, 1, f); pl_glob_buff[sf_op.length] = '\0'; Pl_Create_Oper(Pl_Create_Allocate_Atom(pl_glob_buff), sf_op.type, sf_op.prec, sf_op.left, sf_op.right); } FREAD(&i, sizeof(i), 1, f); Flag_Value(double_quotes) = i; FREAD(&i, sizeof(i), 1, f); Flag_Value(back_quotes) = i; FREAD(&i, sizeof(i), 1, f); Flag_Value(char_conversion) = i; FREAD(&i, sizeof(i), 1, f); Flag_Value(singleton_warning) = i; FREAD(&i, sizeof(i), 1, f); Flag_Value(suspicious_warning) = i; FREAD(&i, sizeof(i), 1, f); Flag_Value(multifile_warning) = i; FREAD(&i, sizeof(i), 1, f); Flag_Value(strict_iso) = i; FREAD(&i, sizeof(i), 1, f); SYS_VAR_SAY_GETC = i; for (;;) { FREAD(&cv, 2, 1, f); c = cv[0]; if (c == 0 && cv[1] == 0) break; pl_char_conv[c] = cv[1]; } fclose(f); return TRUE; } /*-------------------------------------------------------------------------* * PL_ARGUMENT_COUNTER_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Argument_Counter_1(WamWord n_word) { return Pl_Un_Integer_Check(pl_os_argc, n_word); } /*-------------------------------------------------------------------------* * PL_ARGUMENT_VALUE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Argument_Value_2(WamWord i_word, WamWord a_word) { int i; i = Pl_Rd_Positive_Check(i_word); if (i >= pl_os_argc) return FALSE; return Pl_Un_Atom_Check(Pl_Create_Atom(pl_os_argv[i]), a_word); } /*-------------------------------------------------------------------------* * PL_ARGUMENT_LIST_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Argument_List_1(WamWord list_word) { int i; Pl_Check_For_Un_List(list_word); for (i = 1; i < pl_os_argc; i++) { if (!Pl_Get_List(list_word) || !Pl_Unify_Atom(Pl_Create_Atom(pl_os_argv[i]))) return FALSE; list_word = Pl_Unify_Variable(); } return Pl_Get_Nil(list_word); } /*-------------------------------------------------------------------------* * PL_ENVIRON_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Environ_2(WamWord var_name_word, WamWord value_word) { WamWord word, tag_mask; char *var_name; char *value; char **cur_env; char *one_env; int lg; Pl_Check_For_Un_Atom(value_word); DEREF(var_name_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { var_name = Pl_Rd_String_Check(word); value = (char *) getenv(var_name); return value && Pl_Un_String_Check(value, value_word); } /* non deterministic case */ cur_env = environ; one_env = *cur_env++; if (one_env == NULL) return FALSE; if (*cur_env) { A(0) = var_name_word; A(1) = value_word; A(2) = (WamWord) cur_env; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(ENVIRON_ALT, 0), 3); } value = strchr(one_env, '='); lg = value - one_env; var_name = pl_glob_buff; strncpy(var_name, one_env, lg); var_name[lg] = '\0'; value++; /* skip = */ return Pl_Un_String_Check(var_name, var_name_word) && Pl_Get_Atom(Pl_Create_Atom(value), value_word); } /*-------------------------------------------------------------------------* * PL_ENVIRON_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Environ_Alt_0(void) { WamWord var_name_word, value_word; char *var_name; char *value; char **cur_env; char *one_env; int lg; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(ENVIRON_ALT, 0), 0); var_name_word = AB(B, 0); value_word = AB(B, 1); cur_env = (char **) AB(B, 2); one_env = *cur_env++; if (*cur_env == NULL) Delete_Last_Choice_Point(); else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B,0)=var_name_word; AB(B,1)=value_word; #endif AB(B, 2) = (WamWord) cur_env; } value = strchr(one_env, '='); lg = value - one_env; var_name = pl_glob_buff; strncpy(var_name, one_env, lg); var_name[lg] = '\0'; value++; /* skip = */ return Pl_Un_String_Check(var_name, var_name_word) && Pl_Get_Atom(Pl_Create_Atom(value), value_word); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/top_level.pl���������������������������������������������������������������0000644�0001750�0001750�00000026664�13021324543�015643� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : top_level.pl * * Descr.: top Level * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. :- ensure_linked([consult/1, load/1]). top_level :- current_prolog_flag(prolog_name, Name), current_prolog_flag(prolog_version, Version), current_prolog_flag(prolog_copyright, Copyright), current_prolog_flag(address_bits, Bits), current_prolog_flag(compiled_at, Date), current_prolog_flag(c_cc, CC), format(top_level_output, '~N~a ~a (~d bits)~n', [Name, Version, Bits]), format(top_level_output, 'Compiled ~a with ~a~n', [Date, CC]), write(top_level_output, 'By Daniel Diaz'), nl, format(top_level_output, '~a~n', [Copyright]), g_assign('$top_level_cur_module', user), break. break :- '$call_c'('Pl_Set_Ctrl_C_Handler_0'), '$sys_var_read'(10, Level), '$sys_var_read'(11, B), g_read('$all_solutions', All), ( Level > 0 -> format(top_level_output, '~N{Break Level ~d}~n', [Level]) ; true ), '$sys_var_inc'(10), g_read('$cmd_line_consult_file', LFile), '$exec_cmd_line_consult_files'(LFile), g_read('$cmd_line_entry_goal', LGoal), '$exec_cmd_line_entry_goals'(LGoal), g_assign('$cmd_line_entry_goal', []), '$top_level1', '$sys_var_dec'(10), '$sys_var_write'(11, B), g_assign('$all_solutions', All), ( Level > 0 -> format(top_level_output, '~N{End Break}~n', [Level]) ; true ). '$top_level1' :- repeat, g_read('$top_level_cur_module', Module), '$catch_no_debug'('$top_level2', X, '$top_level_exception'(X), Module, top_level, 0), !. '$top_level_abort' :- '$reinit_after_exception', '$sys_var_read'(11, B), write(top_level_output, 'execution aborted\n'), '$catch_sync_for_fail_at'(B). '$top_level_stop' :- '$reinit_after_exception', '$sys_var_read'(11, B), '$catch_sync_for_fail_at'(B). '$top_level_exception'('$post_query_exception'(X)) :- '$reinit_after_exception', !, format(top_level_output, '~Ntop-level exception: ', []), write_term(top_level_output, X, [quoted(true), numbervars(false), namevars(false)]), nl(top_level_output), fail. '$top_level_exception'(X) :- '$reinit_after_exception', format(top_level_output, '~Nuncaught exception: ', []), write_term(top_level_output, X, [quoted(true), numbervars(false), namevars(false)]), nl(top_level_output), fail. '$reinit_after_exception' :- % g_read('$char_conv', CharConv), % set_prolog_flag(char_conversion, CharConv), ( '$sys_var_read'(12, 1) -> g_read('$user_prompt', UserPrompt), '$set_linedit_prompt'(UserPrompt) ; true ). '$top_level2' :- repeat, '$get_current_B'(B), % the current choice-point % '$sys_var_read'(7, B), % the last Handler created by catch/3 (what is better ???) '$sys_var_write'(11, B), %write('top-level catcher'(B)), nl, '$write_indicator', % current_prolog_flag(char_conversion, CharConv), % g_assign('$char_conv', CharConv), % set_prolog_flag(char_conversion, off), Prompt = '| ?- ', ( '$sys_var_read'(12, 1) -> '$get_linedit_prompt'(UserPrompt), g_assign('$user_prompt', UserPrompt), '$set_linedit_prompt'(Prompt) ; write(top_level_output, Prompt) ), flush_output(top_level_output), '$read_query'(X, QueryVars), ( '$sys_var_read'(12, 1) -> '$set_linedit_prompt'(UserPrompt) ; true ), % set_prolog_flag(char_conversion, CharConv), sort(QueryVars, QueryVars1), ( X == end_of_file -> nl(top_level_output), ! ; user_time(Time0), ( '$exec_query'(X, QueryVars1) -> Ok = yes ; Ok = no ), user_time(Time1), Time is Time1 - Time0, format(top_level_output, '~N~n', []), ( Time = 0 -> true ; format(top_level_output, '(~d ms) ', [Time]) ), format(top_level_output, '~a~n', [Ok]), fail ). '$write_indicator' :- g_read('$debug_mode', DebugMode), '$dbg_indicator'(DebugMode, A), '$sys_var_read'(10, Level), ( Level > 1 -> Level1 is Level - 1, ( A = '' -> format(top_level_output, '{~d}~n', [Level1]) ; format(top_level_output, '{~a,~d}~n', [A, Level1]) ) ; A = '' -> true ; format(top_level_output, '{~a}~n', [A]) ), fail. '$write_indicator'. '$dbg_indicator'(trace, trace). '$dbg_indicator'(debug, debug). '$dbg_indicator'(nodebug, ''). '$read_query'(X, QueryVars) :- '$sys_var_read'(10, 1), % comment to execute in nested top-levels g_read('$cmd_line_query_goal', [Goal|LGoal]), g_assign('$cmd_line_query_goal', LGoal), !, Prompt = '| ?- ', ( '$sys_var_read'(12, 1) -> write(top_level_output, Prompt) ; true), format(top_level_output, '~a.~n', [Goal]), read_term_from_atom(Goal, X, [end_of_term(eof), variable_names(QueryVars)]). '$read_query'(X, QueryVars) :- read_term(top_level_input, X, [variable_names(QueryVars)]), '$PB_empty_buffer'(top_level_input). '$exec_query'(X, QueryVars) :- g_read('$debug_mode', DebugMode), g_assign('$debug_next', DebugMode), g_assign('$all_solutions', f), '$get_current_B'(B), '$call_c'('Pl_Save_Regs_For_Signal'), % save some registers in case of CTRL+C g_read('$top_level_cur_module', Module), %format('executing query ~w in module: ~w vars: ~w~n', [X, Module, QueryVars]), '$call'(X, Module, top_level, 0), '$call_c'('Pl_Save_Regs_For_Signal'), % save some registers in case of CTRL+C '$get_current_B'(B1), format(top_level_output, '~N', []), '$catch_no_debug'('$set_query_vars_names'(QueryVars, ToDispVars), Err, throw('$post_query_exception'(Err)), Module, top_level, 0), % '$set_query_vars_names'(QueryVars, ToDispVars), ( fail, % do not activate 'alt if vars' ToDispVars = [] -> true % no alt if only anonymous vars ; '$write_solution'(ToDispVars, B1, B), ( B1 > B -> g_read('$all_solutions', f), % fail for previous 'a' write(top_level_output, ' ? '), '$read_return' % fail for ';' ' ' and 'a' ; true ) ). '$set_query_vars_names'(QueryVars, ToDispVars1) :- name_query_vars(QueryVars, ToDispVars), '$remove_underscore_vars'(ToDispVars, ToDispVars1), name_singleton_vars(ToDispVars1), bind_variables(ToDispVars1, [exclude(QueryVars), namevars]). '$remove_underscore_vars'([], []). '$remove_underscore_vars'([Name = Term|ToDispVars], ToDispVars1) :- ( sub_atom(Name, 0, 1, _, '_') ; Term = '$VARNAME'(Name1), sub_atom(Name1, 0, 1, _, '_')), !, '$remove_underscore_vars'(ToDispVars, ToDispVars1). '$remove_underscore_vars'([X|ToDispVars], [X|ToDispVars1]) :- '$remove_underscore_vars'(ToDispVars, ToDispVars1). '$write_solution'([], B1, B) :- !, ( B1 > B -> format(top_level_output, '~ntrue', []) ; true ). '$write_solution'(ToDispVars, _, _) :- ( current_op(Prior, xfx, =) ; Prior = 700), !, Prior1 is Prior - 1, '$write_solution1'(ToDispVars, Prior1). '$write_solution1'([], _). '$write_solution1'([Name = Value|ToDispVars], Prior) :- ( acyclic_term(Value) -> format(top_level_output, '~n~a = ', [Name]), write_term(top_level_output, Value, [quoted(true), numbervars(false), namevars(true), priority(Prior)]) ; format(top_level_output, '~ncannot display cyclic term for ~a', [Name]) ), '$write_solution1'(ToDispVars, Prior). '$read_return' :- flush_output(top_level_output), get_key(top_level_input, X), '$read_return'(X), !. '$read_return'(10). % newline '$read_return'(13). % carriage-return '$read_return'(97) :- % 'a' g_assign('$all_solutions', t), !, fail. '$read_return'(59) :- % ';' format(top_level_output, '~N', []), !, fail. '$read_return'(32) :- % ' ' (simulate a ';') format(top_level_output, '\b;~N', []), !, fail. '$read_return'(_) :- nl(top_level_output), write(top_level_output, 'Action (; for next solution, a for all solutions, RET to stop) ? '), '$read_return'. /* interface with command-line option consulting files */ '$exec_cmd_line_consult_files'([File|_LFile]) :- '$catch_no_debug'('$consult2'(File, user), error(Err, _), true, system, 'command-line', -1), nonvar(Err), format('~Nwarning: command-line consulting file ~q failed due to ~q~n', [File, Err]), fail. '$exec_cmd_line_consult_files'([_|LFile]) :- !, '$exec_cmd_line_consult_files'(LFile). '$exec_cmd_line_consult_files'(_). % can be another term than [] /* interface with command-line options executing goals */ '$exec_cmd_line_entry_goals'([Goal|LGoal]):- !, '$exec_cmd_line_goal'(Goal), '$exec_cmd_line_entry_goals'(LGoal). '$exec_cmd_line_entry_goals'(_). % can be another term than [] '$exec_cmd_line_goal'(Goal) :- % called by top_level.c ( '$catch_no_debug'('$exec_cmd1'(Goal), Err, '$exec_cmd_err'(Goal, Err), user, 'command-line', -1) -> true ; format('~Nwarning: command-line goal ~q failed~n', [Goal])). '$exec_cmd1'(Goal) :- read_term_from_atom(Goal, TermGoal, [end_of_term(eof)]), '$call'(TermGoal, user, 'command-line', -1). '$exec_cmd_err'(Goal, Err) :- format('~Nwarning: command-line goal ~q caused exception: ~q~n', [Goal, Err]). ����������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/control.pl�����������������������������������������������������������������0000644�0001750�0001750�00000006363�13021324543�015324� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : control.pl * * Descr.: control management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_control'. repeat. repeat :- repeat. abort :- '$call_c_jump'('Pl_Halt_If_No_Top_Level_1'(1)). stop :- '$call_c_jump'('Pl_Halt_If_No_Top_Level_1'(0)). halt :- halt(0). halt(X) :- set_bip_name(halt, 1), '$call_c'('Pl_Halt_1'(X)). between(L, U, X) :- set_bip_name(between, 3), '$call_c_test'('Pl_Between_3'(L, U, X)). '$between_alt' :- '$call_c'('Pl_Between_Alt_0'). for(X, L, U) :- % deprecated: use between/3 instead set_bip_name(for, 3), '$call_c_test'('Pl_Between_3'(L, U, X)). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/assert.pl������������������������������������������������������������������0000644�0001750�0001750�00000010653�13021324543�015142� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : assert.pl * * Descr.: dynamic predicate management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_assert'. :- meta_predicate(asserta(:)). :- meta_predicate(assertz(:)). asserta(C) :- set_bip_name(asserta, 1), '$assert'(C, 1, 1, ''). assertz(C) :- set_bip_name(assertz, 1), '$assert'(C, 0, 1, ''). % also called by consult '$assert'(C, Asserta, CheckPerm, FileName) :- '$call_c'('Pl_Assert_4'(C, Asserta, CheckPerm, FileName)). :- meta_predicate(retract(:)). retract(C) :- set_bip_name(retract, 1), '$call_c_test'('Pl_Retract_1'(C)). :- meta_predicate(retractall(:)). retractall(H) :-% non-det: CP must not be changed (no env) call_c must be alone (inline) set_bip_name(retractall, 1), %inline is OK '$call_c'('Pl_Retractall_1'(H)), %inline is OK fail. retractall(_). :- meta_predicate(clause(:, ?)). clause(H, B) :- set_bip_name(clause, 2), '$check_head'(H), '$clause'(H, B, true). '$clause'(H, B, CheckPublic) :- % non-det: CP must not be changed (no env) call_c must be alone (inline) '$call_c_test'('Pl_Clause_3'(H, B, CheckPublic)). /* OLD CODE '$retract_last_found' :- '$call_c'('Pl_Retract_Last_Found_0'). '$instance_for_setarg'(H, B) :- '$call_c_test'('Pl_Clause_3'(H, B, 0)). '$setarg_in_last_found'(ArgNo, NewValue) :- '$call_c'('Pl_Setarg_Of_Last_Found_2'(ArgNo, NewValue)). */ :- meta_predicate(abolish(:)). abolish(PI) :- set_bip_name(abolish, 1), '$call_c'('Pl_Abolish_1'(PI)). '$scan_dyn_test_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Scan_Dynamic_Pred_Alt_0'). '$scan_dyn_fail_alt' :- % used by C code to create a choice-point '$call_c'('Pl_Scan_Dynamic_Pred_Alt_0'), fail. '$scan_dyn_jump_alt' :- % used by C code to create a choice-point '$call_c_jump'('Pl_Scan_Dynamic_Pred_Alt_0'). �������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/read_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000035725�13021324543�014674� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : read_c.c * * Descr.: read/1 and friends - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define CURRENT_CHAR_CONVERSION_ALT X1_2463757272656E745F636861725F636F6E76657273696F6E5F616C74 Prolog_Prototype(CURRENT_CHAR_CONVERSION_ALT, 0); #define CHECK_STREAM_AND_GET_STM(sora_word, stm) \ stm = (sora_word == NOT_A_WAM_WORD) \ ? pl_stm_input : \ Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); \ \ pl_last_input_sora = sora_word; \ Pl_Check_Stream_Type(stm, TRUE, TRUE) #define CHECK_RESULT_AND_UNIFY(returned_word, term_word) \ if (returned_word == NOT_A_WAM_WORD) \ { \ Pl_Syntax_Error((SYS_VAR_SYNTAX_ERROR_ACTON < 0) \ ? Flag_Value(syntax_error) \ : SYS_VAR_SYNTAX_ERROR_ACTON); \ return FALSE; \ } \ \ if (!Pl_Unify(word, term_word)) \ return FALSE /*-------------------------------------------------------------------------* * PL_READ_TERM_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Term_5(WamWord sora_word, WamWord term_word, WamWord vars_word, WamWord var_names_word, WamWord sing_names_word) { WamWord word; int stm; int i; int parse_end_of_term = (SYS_VAR_OPTION_MASK >> 3) & 1; CHECK_STREAM_AND_GET_STM(sora_word, stm); word = Pl_Read_Term(pl_stm_tbl[stm], parse_end_of_term); CHECK_RESULT_AND_UNIFY(word, term_word); /* list of variables (i.e. [Var,...]) */ if (SYS_VAR_OPTION_MASK & 1) { for (i = 0; i < pl_parse_nb_var; i++) { if (!Pl_Get_List(vars_word) || !Pl_Unify_Value(pl_parse_dico_var[i].word)) return FALSE; vars_word = Pl_Unify_Variable(); } if (!Pl_Get_Nil(vars_word)) return FALSE; } /* list of variable names (i.e. ['Name'=Var,...]) */ if (SYS_VAR_OPTION_MASK & 2) { for (i = 0; i < pl_parse_nb_var; i++) { if (!pl_parse_dico_var[i].named) continue; /* pl_glob_dico_var: variable names (atoms) */ pl_glob_dico_var[i] = Pl_Create_Allocate_Atom(pl_parse_dico_var[i].name); word = Pl_Put_Structure(ATOM_CHAR('='), 2); Pl_Unify_Atom(pl_glob_dico_var[i]); Pl_Unify_Value(pl_parse_dico_var[i].word); if (!Pl_Get_List(var_names_word) || !Pl_Unify_Value(word)) return FALSE; var_names_word = Pl_Unify_Variable(); } if (!Pl_Get_Nil(var_names_word)) return FALSE; } /* list of singletons (i.e. ['Name'=Var,...]) */ if (SYS_VAR_OPTION_MASK & 4) { for (i = 0; i < pl_parse_nb_var; i++) { if (!pl_parse_dico_var[i].named || pl_parse_dico_var[i].nb_of_uses > 1) continue; if ((SYS_VAR_OPTION_MASK & 2) == 0) /* not yet allocated */ pl_glob_dico_var[i] = Pl_Create_Allocate_Atom(pl_parse_dico_var[i].name); word = Pl_Put_Structure(ATOM_CHAR('='), 2); Pl_Unify_Atom(pl_glob_dico_var[i]); Pl_Unify_Value(pl_parse_dico_var[i].word); if (!Pl_Get_List(sing_names_word) || !Pl_Unify_Value(word)) return FALSE; sing_names_word = Pl_Unify_Variable(); } if (!Pl_Get_Nil(sing_names_word)) return FALSE; } return TRUE; } /*-------------------------------------------------------------------------* * PL_READ_TERM_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Term_4(WamWord term_word, WamWord vars_word, WamWord var_names_word, WamWord sing_names_word) { return Pl_Read_Term_5(NOT_A_WAM_WORD, term_word, vars_word, var_names_word, sing_names_word); } /*-------------------------------------------------------------------------* * PL_READ_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_1(WamWord term_word) { return Pl_Read_Term_5(NOT_A_WAM_WORD, term_word, 0, 0, 0); } /*-------------------------------------------------------------------------* * PL_READ_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_2(WamWord sora_word, WamWord term_word) { return Pl_Read_Term_5(sora_word, term_word, 0, 0, 0); } /*-------------------------------------------------------------------------* * PL_READ_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Atom_2(WamWord sora_word, WamWord atom_word) { WamWord word; int stm; Pl_Check_For_Un_Atom(atom_word); CHECK_STREAM_AND_GET_STM(sora_word, stm); word = Pl_Read_Atom(pl_stm_tbl[stm]); CHECK_RESULT_AND_UNIFY(word, atom_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_READ_ATOM_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Atom_1(WamWord atom_word) { return Pl_Read_Atom_2(NOT_A_WAM_WORD, atom_word); } /*-------------------------------------------------------------------------* * PL_READ_INTEGER_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Integer_2(WamWord sora_word, WamWord integer_word) { WamWord word; int stm; Pl_Check_For_Un_Integer(integer_word); CHECK_STREAM_AND_GET_STM(sora_word, stm); word = Pl_Read_Integer(pl_stm_tbl[stm]); CHECK_RESULT_AND_UNIFY(word, integer_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_READ_INTEGER_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Integer_1(WamWord integer_word) { return Pl_Read_Integer_2(NOT_A_WAM_WORD, integer_word); } /*-------------------------------------------------------------------------* * PL_READ_NUMBER_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Number_2(WamWord sora_word, WamWord number_word) { WamWord word; int stm; Pl_Check_For_Un_Number(number_word); CHECK_STREAM_AND_GET_STM(sora_word, stm); word = Pl_Read_Number(pl_stm_tbl[stm]); CHECK_RESULT_AND_UNIFY(word, number_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_READ_NUMBER_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Number_1(WamWord number_word) { return Pl_Read_Number_2(NOT_A_WAM_WORD, number_word); } /*-------------------------------------------------------------------------* * PL_READ_TOKEN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Token_2(WamWord sora_word, WamWord token_word) { WamWord word; int stm; CHECK_STREAM_AND_GET_STM(sora_word, stm); word = Pl_Read_Token(pl_stm_tbl[stm]); CHECK_RESULT_AND_UNIFY(word, token_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_READ_TOKEN_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Read_Token_1(WamWord token_word) { return Pl_Read_Token_2(NOT_A_WAM_WORD, token_word); } /*-------------------------------------------------------------------------* * PL_LAST_READ_START_LINE_COLUMN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Last_Read_Start_Line_Column_2(WamWord line_word, WamWord col_word) { return Pl_Un_Integer_Check(pl_last_read_line, line_word) && Pl_Un_Integer_Check(pl_last_read_col, col_word); } /*-------------------------------------------------------------------------* * PL_CHAR_CONVERSION_2 * * * *-------------------------------------------------------------------------*/ void Pl_Char_Conversion_2(WamWord in_char_word, WamWord out_char_word) { int c_in, c_out; c_in = Pl_Rd_Char_Check(in_char_word); c_out = Pl_Rd_Char_Check(out_char_word); pl_char_conv[c_in] = c_out; } #define Find_Next_Char_Conversion(c_in, c_out) \ while (++c_in < 256) \ { \ c_out = pl_char_conv[c_in]; \ if (c_in != c_out) \ break; \ } /*-------------------------------------------------------------------------* * PL_CURRENT_CHAR_CONVERSION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Char_Conversion_2(WamWord in_char_word, WamWord out_char_word) { WamWord word, tag_mask; int c_in, c_out; int c_in1, c_out1; Pl_Check_For_Un_Char(out_char_word); DEREF(in_char_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { c_in = Pl_Rd_Char_Check(word); c_out = pl_char_conv[c_in]; return c_in != c_out && Pl_Un_Char_Check(c_out, out_char_word); } c_in = -1; Find_Next_Char_Conversion(c_in, c_out); if (c_in >= 256) return FALSE; c_in1 = c_in; Find_Next_Char_Conversion(c_in1, c_out1); if (c_in1 < 256) /* non deterministic case */ { A(0) = in_char_word; A(1) = out_char_word; A(2) = c_in1; A(3) = c_out1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_CHAR_CONVERSION_ALT, 0), 4); } return Pl_Get_Atom(ATOM_CHAR(c_in), in_char_word) && Pl_Get_Atom(ATOM_CHAR(c_out), out_char_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_CHAR_CONVERSION_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Char_Conversion_Alt_0(void) { WamWord in_char_word, out_char_word; int c_in, c_out; int c_in1, c_out1; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_CHAR_CONVERSION_ALT, 0), 0); in_char_word = AB(B, 0); out_char_word = AB(B, 1); c_in = AB(B, 2); c_out = AB(B, 3); c_in1 = c_in; Find_Next_Char_Conversion(c_in1, c_out1); if (c_in1 >= 256) Delete_Last_Choice_Point(); else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = in_char_word; AB(B, 1) = out_char_word; #endif AB(B, 2) = c_in1; AB(B, 3) = c_out1; } return Pl_Get_Atom(ATOM_CHAR(c_in), in_char_word) && Pl_Get_Atom(ATOM_CHAR(c_out), out_char_word); } �������������������������������������������gprolog-1.4.5/src/BipsPl/no_le_interf.wam�����������������������������������������������������������0000644�0001750�0001750�00000000615�13021356407�016456� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : no_le_interf.pl file_name('/home/diaz/GP/src/BipsPl/no_le_interf.pl'). predicate(system:'$use_le_interf'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:'$get_linedit_prompt'/1,44,static,private,monofile,built_in,[ proceed]). predicate(system:'$set_linedit_prompt'/1,46,static,private,monofile,built_in,[ proceed]). �������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/assert.wam�����������������������������������������������������������������0000644�0001750�0001750�00000006222�13021356407�015314� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : assert.pl file_name('/home/diaz/GP/src/BipsPl/assert.pl'). predicate(system:'$use_assert'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:asserta/1,46,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[asserta,1]), put_integer(1,1), put_integer(1,2), put_atom('',3), execute('$assert'/4)]). predicate(system:assertz/1,53,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[assertz,1]), put_integer(0,1), put_integer(1,2), put_atom('',3), execute('$assert'/4)]). predicate(system:'$assert'/4,60,static,private,monofile,built_in,[ call_c('Pl_Assert_4',[],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:retract/1,67,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[retract,1]), call_c('Pl_Retract_1',[boolean],[x(0)]), proceed]). predicate(system:retractall/1,74,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[retractall,1]), call_c('Pl_Retractall_1',[],[x(0)]), fail, label(1), trust_me_else_fail, proceed]). predicate(system:clause/2,86,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[clause,2]), put_value(y(0),0), call('$check_head'/1), put_value(y(0),0), put_value(y(1),1), put_atom(true,2), deallocate, execute('$clause'/3)]). predicate(system:'$clause'/3,92,static,private,monofile,built_in,[ call_c('Pl_Clause_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:abolish/1,108,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[abolish,1]), call_c('Pl_Abolish_1',[],[x(0)]), proceed]). predicate(system:'$scan_dyn_test_alt'/0,115,static,private,monofile,built_in,[ call_c('Pl_Scan_Dynamic_Pred_Alt_0',[boolean],[]), proceed]). predicate(system:'$scan_dyn_fail_alt'/0,118,static,private,monofile,built_in,[ call_c('Pl_Scan_Dynamic_Pred_Alt_0',[],[]), fail]). predicate(system:'$scan_dyn_jump_alt'/0,122,static,private,monofile,built_in,[ call_c('Pl_Scan_Dynamic_Pred_Alt_0',[jump],[]), proceed]). directive(43,system,[ put_atom(user,0), put_structure(asserta/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(44,system,[ put_atom(user,0), put_structure(assertz/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(65,system,[ put_atom(user,0), put_structure(retract/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(72,system,[ put_atom(user,0), put_structure(retractall/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(84,system,[ put_atom(user,0), put_structure(clause/2,1), unify_atom(:), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(106,system,[ put_atom(user,0), put_structure(abolish/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/dec10io.pl�����������������������������������������������������������������0000644�0001750�0001750�00000013532�13021324543�015064� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : dec10io.pl * * Descr.: DEC-10 I/O compatibility library * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_dec10io'. '$find_existing_stream'(user, '$stream'(0), input). '$find_existing_stream'(user_input, '$stream'(0), input). '$find_existing_stream'(user, '$stream'(1), output). '$find_existing_stream'(user_output, '$stream'(1), output). '$find_existing_stream'(File, Stream, Mode) :- clause('$dec10_stream'(File, Stream, Mode), _), !, ( current_stream(Stream), % test if it still exists stream_property(Stream, file_name(File)), % (with correct name) stream_property(Stream, Mode) % (and correct mode) -> true ; retract('$dec10_stream'(File, Stream, Mode)), % no, retract fail ). '$find_existing_stream'(Stream, Stream, Mode) :- Stream = '$stream'(S), % test if it is a stream integer(S), current_stream(Stream), stream_property(Stream, Mode). see(File) :- set_bip_name(see, 1), nonvar(File), !, ( '$find_existing_stream'(File, Stream, input) ; set_bip_name(see, 1), '$open'(File, read, Stream, []), assertz('$dec10_stream'(File, Stream, input)) ), !, set_input(Stream). see(_) :- '$pl_err_instantiation'. seeing(File) :- set_bip_name(seeing, 1), current_input(Stream), '$find_existing_stream'(File, Stream, input), !. seen :- set_bip_name(seen, 0), current_input(Stream), close(Stream), % before find_existing to retract ( '$find_existing_stream'(_, Stream, input) ; true ), !. tell(File) :- set_bip_name(tell, 1), nonvar(File), !, ( '$find_existing_stream'(File, Stream, output) ; set_bip_name(tell, 1), '$open'(File, write, Stream, []), assertz('$dec10_stream'(File, Stream, output)) ), !, set_output(Stream). tell(_) :- '$pl_err_instantiation'. telling(File) :- set_bip_name(telling, 1), current_output(Stream), '$find_existing_stream'(File, Stream, output), !. told :- set_bip_name(told, 0), current_output(Stream), close(Stream), % before find_existing to retract ( '$find_existing_stream'(_, Stream, output) ; true ), !. append(File) :- set_bip_name(append, 1), nonvar(File), !, ( '$find_existing_stream'(File, Stream, output) ; set_bip_name(append, 1), '$open'(File, append, Stream, []), assertz('$dec10_stream'(File, Stream, output)) ), !, set_output(Stream). append(_) :- '$pl_err_instantiation'. get0(X) :- set_bip_name(get0, 1), '$call_c_test'('Pl_Get_Code_1'(X)). get(X) :- set_bip_name(get, 1), '$check_in_character_code'(X), '$call_c_test'('Pl_Get_Code_1'(X0)), ( X0 =< 32 -> get(X) ; X = X0 ). put(X) :- set_bip_name(put, 1), '$call_c'('Pl_Put_Code_1'(X)). skip(X) :- set_bip_name(skip, 1), '$check_in_character_code'(X), repeat, '$call_c_test'('Pl_Get_Code_1'(X0)), X0 = X, !. '$check_in_character_code'(X) :- var(X), !. '$check_in_character_code'(X) :- integer(X), !, ( X >= -1, X =< 255 -> true ; '$pl_err_representation'(in_character_code) ). '$check_in_character_code'(X) :- '$pl_err_type'(integer, X). tab(Exp) :- set_bip_name(tab, 1), '$arith_eval'(Exp, N), for(_, 1, N), put_char(' '), fail. tab(_). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/call_args.wam��������������������������������������������������������������0000644�0001750�0001750�00000020365�13021356407�015746� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : call_args.pl file_name('/home/diaz/GP/src/BipsPl/call_args.pl'). predicate(system:'$use_call_args'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:call_with_args/1,56,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,0]), proceed]). predicate(system:call_with_args/2,59,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,1]), proceed]). predicate(system:call_with_args/3,62,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,2]), proceed]). predicate(system:call_with_args/4,65,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,3]), proceed]). predicate(system:call_with_args/5,68,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,4]), proceed]). predicate(system:call_with_args/6,71,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,5]), proceed]). predicate(system:call_with_args/7,74,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,6]), proceed]). predicate(system:call_with_args/8,77,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,7]), proceed]). predicate(system:call_with_args/9,80,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,8]), proceed]). predicate(system:call_with_args/10,83,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,9]), proceed]). predicate(system:call_with_args/11,86,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call_with_args,10]), proceed]). predicate(system:call/2,101,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,1]), proceed]). predicate(system:call/3,104,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,2]), proceed]). predicate(system:call/4,107,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,3]), proceed]). predicate(system:call/5,110,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,4]), proceed]). predicate(system:call/6,113,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,5]), proceed]). predicate(system:call/7,116,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,6]), proceed]). predicate(system:call/8,119,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,7]), proceed]). predicate(system:call/9,122,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,8]), proceed]). predicate(system:call/10,125,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,9]), proceed]). predicate(system:call/11,128,static,private,monofile,built_in,[ call_c('Pl_Call_Closure',[jump,by_value],[call,10]), proceed]). directive(44,system,[ put_atom(user,0), put_structure(call_with_args/1,1), unify_integer(1), execute('$declare_meta_predicate'/2)]). directive(45,system,[ put_atom(user,0), put_structure(call_with_args/2,1), unify_integer(1), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(46,system,[ put_atom(user,0), put_structure(call_with_args/3,1), unify_integer(2), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(47,system,[ put_atom(user,0), put_structure(call_with_args/4,1), unify_integer(3), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(48,system,[ put_atom(user,0), put_structure(call_with_args/5,1), unify_integer(4), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(49,system,[ put_atom(user,0), put_structure(call_with_args/6,1), unify_integer(5), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(50,system,[ put_atom(user,0), put_structure(call_with_args/7,1), unify_integer(6), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(51,system,[ put_atom(user,0), put_structure(call_with_args/8,1), unify_integer(7), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(52,system,[ put_atom(user,0), put_structure(call_with_args/9,1), unify_integer(8), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(53,system,[ put_atom(user,0), put_structure(call_with_args/10,1), unify_integer(9), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(54,system,[ put_atom(user,0), put_structure(call_with_args/11,1), unify_integer(10), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(90,system,[ put_atom(user,0), put_structure(call/2,1), unify_integer(1), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(91,system,[ put_atom(user,0), put_structure(call/3,1), unify_integer(2), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(92,system,[ put_atom(user,0), put_structure(call/4,1), unify_integer(3), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(93,system,[ put_atom(user,0), put_structure(call/5,1), unify_integer(4), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(94,system,[ put_atom(user,0), put_structure(call/6,1), unify_integer(5), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(95,system,[ put_atom(user,0), put_structure(call/7,1), unify_integer(6), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(96,system,[ put_atom(user,0), put_structure(call/8,1), unify_integer(7), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(97,system,[ put_atom(user,0), put_structure(call/9,1), unify_integer(8), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(98,system,[ put_atom(user,0), put_structure(call/10,1), unify_integer(9), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(99,system,[ put_atom(user,0), put_structure(call/11,1), unify_integer(10), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/error_supp.c���������������������������������������������������������������0000644�0001750�0001750�00000066057�13021324543�015661� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : error_supp.c * * Descr.: Prolog errors support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <errno.h> #include <string.h> #define OBJ_INIT Error_Supp_Initializer #define ERROR_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int cur_bip_func; static int cur_bip_arity; static char *c_bip_func_str; static int c_bip_arity; static char *last_err_file = NULL; static int last_err_line; static int last_err_col; static char *last_err_msg; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Update_Cur_From_C_Bip(void); static char *Context_Error_String(void); #define PL_ERR_INSTANTIATION X1_24706C5F6572725F696E7374616E74696174696F6E #define PL_ERR_UNINSTANTIATION X1_24706C5F6572725F756E696E7374616E74696174696F6E #define PL_ERR_TYPE X1_24706C5F6572725F74797065 #define PL_ERR_DOMAIN X1_24706C5F6572725F646F6D61696E #define PL_ERR_EXISTENCE X1_24706C5F6572725F6578697374656E6365 #define PL_ERR_PERMISSION X1_24706C5F6572725F7065726D697373696F6E #define PL_ERR_REPRESENTATION X1_24706C5F6572725F726570726573656E746174696F6E #define PL_ERR_EVALUATION X1_24706C5F6572725F6576616C756174696F6E #define PL_ERR_RESOURCE X1_24706C5F6572725F7265736F75726365 #define PL_ERR_SYNTAX X1_24706C5F6572725F73796E746178 #define PL_ERR_SYSTEM X1_24706C5F6572725F73797374656D Prolog_Prototype(PL_ERR_INSTANTIATION, 0); Prolog_Prototype(PL_ERR_UNINSTANTIATION, 1); Prolog_Prototype(PL_ERR_TYPE, 2); Prolog_Prototype(PL_ERR_DOMAIN, 2); Prolog_Prototype(PL_ERR_EXISTENCE, 2); Prolog_Prototype(PL_ERR_PERMISSION, 3); Prolog_Prototype(PL_ERR_REPRESENTATION, 1); Prolog_Prototype(PL_ERR_EVALUATION, 1); Prolog_Prototype(PL_ERR_RESOURCE, 1); Prolog_Prototype(PL_ERR_SYNTAX, 1); Prolog_Prototype(PL_ERR_SYSTEM, 1); /*-------------------------------------------------------------------------* * ERROR_SUPP_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Error_Supp_Initializer(void) { pl_type_atom = Pl_Create_Atom("atom"); pl_type_atomic = Pl_Create_Atom("atomic"); pl_type_byte = Pl_Create_Atom("byte"); pl_type_callable = Pl_Create_Atom("callable"); pl_type_character = Pl_Create_Atom("character"); pl_type_compound = Pl_Create_Atom("compound"); pl_type_evaluable = Pl_Create_Atom("evaluable"); pl_type_float = Pl_Create_Atom("float"); /* for arithmetic */ pl_type_boolean = Pl_Create_Atom("boolean"); /* for setarg/4 */ pl_type_in_byte = Pl_Create_Atom("in_byte"); pl_type_in_character = Pl_Create_Atom("in_character"); pl_type_integer = Pl_Create_Atom("integer"); pl_type_list = Pl_Create_Atom("list"); pl_type_number = Pl_Create_Atom("number"); pl_type_predicate_indicator = Pl_Create_Atom("predicate_indicator"); pl_type_variable = Pl_Create_Atom("variable"); /* deprecated: new code should emit an uninstantiation_error */ pl_type_pair = Pl_Create_Atom("pair"); if (pl_fd_init_solver) /* FD solver linked */ { pl_type_fd_variable = Pl_Create_Atom("fd_variable"); /* for FD */ pl_type_fd_evaluable = Pl_Create_Atom("fd_evaluable"); /* for FD */ pl_type_fd_bool_evaluable = Pl_Create_Atom("fd_bool_evaluable"); /* for FD */ } pl_domain_character_code_list = Pl_Create_Atom("character_code_list"); pl_domain_close_option = Pl_Create_Atom("close_option"); pl_domain_flag_value = Pl_Create_Atom("flag_value"); pl_domain_io_mode = Pl_Create_Atom("io_mode"); pl_domain_non_empty_list = Pl_Create_Atom("non_empty_list"); pl_domain_not_less_than_zero = Pl_Create_Atom("not_less_than_zero"); pl_domain_operator_priority = Pl_Create_Atom("operator_priority"); pl_domain_operator_specifier = Pl_Create_Atom("operator_specifier"); pl_domain_prolog_flag = Pl_Create_Atom("prolog_flag"); pl_domain_read_option = Pl_Create_Atom("read_option"); pl_domain_source_sink = Pl_Create_Atom("source_sink"); pl_domain_stream = Pl_Create_Atom("stream"); pl_domain_stream_option = Pl_Create_Atom("stream_option"); pl_domain_stream_or_alias = Pl_Create_Atom("stream_or_alias"); pl_domain_stream_position = Pl_Create_Atom("stream_position"); pl_domain_stream_property = Pl_Create_Atom("stream_property"); pl_domain_write_option = Pl_Create_Atom("write_option"); pl_domain_order = Pl_Create_Atom("order"); pl_domain_term_stream_or_alias = Pl_Create_Atom("term_stream_or_alias"); /* for term_streams */ pl_domain_g_array_index = Pl_Create_Atom("g_array_index");/* for g_vars */ pl_domain_g_argument_selector = Pl_Create_Atom("g_argument_selector"); /* for g_vars */ pl_domain_stream_seek_method = Pl_Create_Atom("stream_seek_method"); /* for seek/4 */ pl_domain_format_control_sequence = Pl_Create_Atom("format_control_sequence"); /* for format/2-3 */ pl_domain_os_path = Pl_Create_Atom("os_path");/* for absolute_file_name/2 */ pl_domain_os_file_permission = Pl_Create_Atom("os_file_permission"); /* for file_permission/2 */ pl_domain_date_time = Pl_Create_Atom("date_time");/* for os_interf */ pl_domain_selectable_item = Pl_Create_Atom("selectable_item"); /* for select_read/3 */ #ifndef NO_USE_SOCKETS pl_domain_socket_domain = Pl_Create_Atom("socket_domain"); /* for sockets */ pl_domain_socket_address = Pl_Create_Atom("socket_address"); /* for sockets */ #endif pl_existence_procedure = Pl_Create_Atom("procedure"); pl_existence_source_sink = Pl_Create_Atom("source_sink"); pl_existence_stream = Pl_Create_Atom("stream"); pl_existence_sr_descriptor = Pl_Create_Atom("sr_descriptor"); /* for source reader */ pl_permission_operation_access = Pl_Create_Atom("access"); pl_permission_operation_close = Pl_Create_Atom("close"); pl_permission_operation_create = Pl_Create_Atom("create"); pl_permission_operation_input = Pl_Create_Atom("input"); pl_permission_operation_modify = Pl_Create_Atom("modify"); pl_permission_operation_open = Pl_Create_Atom("open"); pl_permission_operation_output = Pl_Create_Atom("output"); pl_permission_operation_reposition = Pl_Create_Atom("reposition"); pl_permission_operation_execute = Pl_Create_Atom("execute"); pl_permission_type_binary_stream = Pl_Create_Atom("binary_stream"); pl_permission_type_flag = Pl_Create_Atom("flag"); pl_permission_type_operator = Pl_Create_Atom("operator"); pl_permission_type_past_end_of_stream = Pl_Create_Atom("past_end_of_stream"); pl_permission_type_private_procedure = Pl_Create_Atom("private_procedure"); pl_permission_type_static_procedure = Pl_Create_Atom("static_procedure"); pl_permission_type_source_sink = Pl_Create_Atom("source_sink"); pl_permission_type_stream = Pl_Create_Atom("stream"); pl_permission_type_text_stream = Pl_Create_Atom("text_stream"); pl_permission_type_non_exported_procedure = Pl_Create_Atom("non_exported_procedure"); pl_representation_character = Pl_Create_Atom("character"); pl_representation_character_code = Pl_Create_Atom("character_code"); pl_representation_in_character_code = Pl_Create_Atom("in_character_code"); pl_representation_max_arity = Pl_Create_Atom("max_arity"); pl_representation_max_integer = Pl_Create_Atom("max_integer"); pl_representation_min_integer = Pl_Create_Atom("min_integer"); pl_representation_too_many_variables = Pl_Create_Atom("too_many_variables"); /* for Pl_Copy_Term(),... */ pl_evluation_float_overflow = Pl_Create_Atom("float_overflow"); pl_evluation_int_overflow = Pl_Create_Atom("int_overflow"); pl_evluation_undefined = Pl_Create_Atom("undefined"); pl_evluation_underflow = Pl_Create_Atom("underflow"); pl_evluation_zero_divisor = Pl_Create_Atom("zero_divisor"); pl_resource_print_object_not_linked = Pl_Create_Atom("print_object_not_linked"); /* for print and format */ if (pl_fd_init_solver) /* FD solver linked */ { pl_resource_too_big_fd_constraint = Pl_Create_Atom("too_big_fd_constraint"); /* for FD */ } pl_calling_module = pl_atom_user; } /*-------------------------------------------------------------------------* * PL_SET_BIP_NAME_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Bip_Name_2(WamWord func_word, WamWord arity_word) { PlLong arity; /* use PlLong to avoid truncation */ Pl_Set_C_Bip_Name("set_bip_name", 2); /* Use the module part ??? ignore if system or user ? (a Bip is in system) */ Pl_Strip_Module(func_word, FALSE, FALSE, &func_word); cur_bip_func = Pl_Rd_Atom_Check(func_word); arity = Pl_Rd_Integer_Check(arity_word); if (arity > MAX_ARITY) arity = -1; cur_bip_arity = arity; Pl_Unset_C_Bip_Name(); c_bip_func_str = NULL; } /*-------------------------------------------------------------------------* * PL_SET_BIP_NAME_UNTAGGED_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Bip_Name_Untagged_2(int func, int arity) { cur_bip_func = func; cur_bip_arity = arity; } /*-------------------------------------------------------------------------* * PL_CURRENT_BIP_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Bip_Name_2(WamWord func_word, WamWord arity_word) { Bool res; Pl_Set_C_Bip_Name("current_bip_name", 2); res = Pl_Un_Atom_Check(cur_bip_func, func_word) && Pl_Un_Integer_Check(cur_bip_arity, arity_word); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_SET_C_BIP_NAME * * * *-------------------------------------------------------------------------*/ void Pl_Set_C_Bip_Name(char *func_str, int arity) { c_bip_func_str = func_str; c_bip_arity = arity; } /*-------------------------------------------------------------------------* * PL_UNSET_C_BIP_NAME * * * *-------------------------------------------------------------------------*/ void Pl_Unset_C_Bip_Name(void) { c_bip_func_str = NULL; } /*-------------------------------------------------------------------------* * PL_GET_CURRENT_BIP * * * * returns func and initializes arity of the current bip. * *-------------------------------------------------------------------------*/ int Pl_Get_Current_Bip(int *arity) { Update_Cur_From_C_Bip(); *arity = cur_bip_arity; return cur_bip_func; } /*-------------------------------------------------------------------------* * PL_GET_BIP_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Bip_Name_2(WamWord func_word, WamWord arity_word) { Pl_Set_C_Bip_Name("get_bip_name", 2); Pl_Check_For_Un_Atom(func_word); Pl_Check_For_Un_Integer(arity_word); return Pl_Get_Atom(cur_bip_func, func_word) && Pl_Get_Integer(cur_bip_arity, arity_word); } /*-------------------------------------------------------------------------* * UPDATE_CUR_FROM_C_BIP * * * *-------------------------------------------------------------------------*/ static void Update_Cur_From_C_Bip(void) { if (c_bip_func_str) { cur_bip_func = Pl_Create_Allocate_Atom(c_bip_func_str); cur_bip_arity = c_bip_arity; } } /*-------------------------------------------------------------------------* * PL_CONTEXT_ERROR_1 * * * *-------------------------------------------------------------------------*/ void Pl_Context_Error_1(WamWord err_word) { if (cur_bip_arity >= 0) { Pl_Get_Structure(ATOM_CHAR('/'), 2, err_word); Pl_Unify_Atom(cur_bip_func); Pl_Unify_Integer(cur_bip_arity); } else Pl_Get_Atom(cur_bip_func, err_word); } /*-------------------------------------------------------------------------* * CONTEXT_ERROR_STRING * * * *-------------------------------------------------------------------------*/ static char * Context_Error_String(void) { static char buff[256]; sprintf(buff, "%s", pl_atom_tbl[cur_bip_func].name); if (cur_bip_arity >= 0) sprintf(buff + strlen(buff), "/%d", cur_bip_arity); return buff; } /*-------------------------------------------------------------------------* * PL_SET_LAST_SYNTAX_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Set_Last_Syntax_Error(char *file_name, int err_line, int err_col, char *err_msg) { last_err_file = file_name; last_err_line = err_line; last_err_col = err_col; last_err_msg = err_msg; } /*-------------------------------------------------------------------------* * PL_SYNTAX_ERROR_INFO_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Syntax_Error_Info_4(WamWord file_name_word, WamWord line_word, WamWord char_word, WamWord msg_word) { Pl_Check_For_Un_Atom(file_name_word); Pl_Check_For_Un_Integer(line_word); Pl_Check_For_Un_Integer(char_word); Pl_Check_For_Un_Atom(msg_word); return last_err_file && Pl_Un_String(last_err_file, file_name_word) && Pl_Un_Integer(last_err_line, line_word) && Pl_Un_Integer(last_err_col, char_word) && Pl_Un_String(last_err_msg, msg_word); } /*-------------------------------------------------------------------------* * PL_SYNTAX_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Syntax_Error(int flag_value) { char str[512]; if (last_err_file == NULL || *last_err_file == '\0') sprintf(str, "(char:%d) %s", last_err_col, last_err_msg); else sprintf(str, "%s:%d (char:%d) %s", last_err_file, last_err_line, last_err_col, last_err_msg); if (flag_value == PF_ERR_ERROR) Pl_Err_Syntax(Pl_Create_Allocate_Atom(str)); Update_Cur_From_C_Bip(); if (flag_value == PF_ERR_WARNING) Pl_Stream_Printf(pl_stm_tbl[pl_stm_top_level_output], "warning: syntax error: %s (from %s)\n", str, Context_Error_String()); } /*-------------------------------------------------------------------------* * NEED_MODULE_PREFIX * * * *-------------------------------------------------------------------------*/ Bool Need_Module_Prefix(int module) { int cc_module = pl_calling_module; if (cc_module == pl_atom_system || cc_module < 0) cc_module = pl_atom_user; if (module == pl_atom_system || module < 0) module = pl_atom_user; return (module != cc_module); } /*-------------------------------------------------------------------------* * PL_BUILD_PRED_INDIC_ERROR0 * * * *-------------------------------------------------------------------------*/ WamWord Pl_Build_Pred_Indic_Error0(int module, int func, int arity) { WamWord term; term = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(func); Pl_Unify_Integer(arity); if (Need_Module_Prefix(module)) { WamWord term1 = Pl_Put_Structure(ATOM_CHAR(':'), 2); Pl_Unify_Atom(module); Pl_Unify_Value(term); term = term1; } return term; } /*-------------------------------------------------------------------------* * PL_BUILD_PRED_INDIC_ERROR * * * *-------------------------------------------------------------------------*/ WamWord Pl_Build_Pred_Indic_Error(PredInf *pred) { int module = pred->mod->module; int func = Functor_Of(pred->f_n); int arity = Arity_Of(pred->f_n); return Pl_Build_Pred_Indic_Error0(module, func, arity); } /*-------------------------------------------------------------------------* * PL_UNKNOWN_PRED_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Unknown_Pred_Error(int module, int func, int arity) { WamWord term; if (Flag_Value(unknown) == PF_ERR_ERROR) { term = Pl_Build_Pred_Indic_Error0(module, func, arity); Pl_Err_Existence(pl_existence_procedure, term); } Update_Cur_From_C_Bip(); if (Flag_Value(unknown) == PF_ERR_WARNING) { Pl_Stream_Printf(pl_stm_tbl[pl_stm_top_level_output], "warning: unknown procedure "); if (Need_Module_Prefix(module)) Pl_Stream_Printf(pl_stm_tbl[pl_stm_top_level_output], "%s:", pl_atom_tbl[module].name); Pl_Stream_Printf(pl_stm_tbl[pl_stm_top_level_output], "%s/%d (from %s)\n", pl_atom_tbl[func].name, arity, Context_Error_String()); } } /*-------------------------------------------------------------------------* * PL_OS_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Os_Error(int ret_val) { char *err_str = Pl_M_Sys_Err_String(ret_val); if (Flag_Value(os_error) == PF_ERR_ERROR) Pl_Err_System(Pl_Create_Allocate_Atom(err_str)); Update_Cur_From_C_Bip(); if (Flag_Value(os_error) == PF_ERR_WARNING) Pl_Stream_Printf(pl_stm_tbl[pl_stm_top_level_output], "warning: OS error: %s (from %s)\n", err_str, Context_Error_String()); } /*-------------------------------------------------------------------------* * PL_ERR_INSTANTIATION * * * *-------------------------------------------------------------------------*/ void Pl_Err_Instantiation(void) { Update_Cur_From_C_Bip(); Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_INSTANTIATION, 0)); } /*-------------------------------------------------------------------------* * PL_ERR_UNINSTANTIATION * * * *-------------------------------------------------------------------------*/ void Pl_Err_Uninstantiation(WamWord term) { Update_Cur_From_C_Bip(); A(0) = term; Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_UNINSTANTIATION, 1)); } /*-------------------------------------------------------------------------* * PL_ERR_TYPE * * * *-------------------------------------------------------------------------*/ void Pl_Err_Type(int atom_type, WamWord term) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(atom_type); A(1) = term; Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_TYPE, 2)); } /*-------------------------------------------------------------------------* * PL_ERR_DOMAIN * * * *-------------------------------------------------------------------------*/ void Pl_Err_Domain(int atom_domain, WamWord term) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(atom_domain); A(1) = term; Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_DOMAIN, 2)); } /*-------------------------------------------------------------------------* * PL_ERR_EXISTENCE * * * *-------------------------------------------------------------------------*/ void Pl_Err_Existence(int atom_object, WamWord term) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(atom_object); A(1) = term; Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_EXISTENCE, 2)); } /*-------------------------------------------------------------------------* * PL_ERR_PERMISSION * * * *-------------------------------------------------------------------------*/ void Pl_Err_Permission(int atom_oper, int atom_perm, WamWord term) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(atom_oper); A(1) = Tag_ATM(atom_perm); A(2) = term; Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_PERMISSION, 3)); } /*-------------------------------------------------------------------------* * PL_ERR_REPRESENTATION * * * *-------------------------------------------------------------------------*/ void Pl_Err_Representation(int atom_flag) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(atom_flag); Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_REPRESENTATION, 1)); } /*-------------------------------------------------------------------------* * PL_ERR_EVALUATION * * * *-------------------------------------------------------------------------*/ void Pl_Err_Evaluation(int pl_atom_error) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(pl_atom_error); Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_EVALUATION, 1)); } /*-------------------------------------------------------------------------* * PL_ERR_RESOURCE * * * *-------------------------------------------------------------------------*/ void Pl_Err_Resource(int atom_resource) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(atom_resource); Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_RESOURCE, 1)); } /*-------------------------------------------------------------------------* * PL_ERR_SYNTAX * * * *-------------------------------------------------------------------------*/ void Pl_Err_Syntax(int pl_atom_error) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(pl_atom_error); Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_SYNTAX, 1)); } /*-------------------------------------------------------------------------* * PL_ERR_SYSTEM * * * *-------------------------------------------------------------------------*/ void Pl_Err_System(int pl_atom_error) { Update_Cur_From_C_Bip(); A(0) = Tag_ATM(pl_atom_error); Pl_Execute_A_Continuation(Prolog_Predicate(PL_ERR_SYSTEM, 1)); } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/throw.wam������������������������������������������������������������������0000644�0001750�0001750�00000002373�13021356407�015161� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : throw.pl file_name('/home/diaz/GP/src/BipsPl/throw.pl'). predicate(system:'$use_throw'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:'$throw'/4,48,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(1), get_variable(y(0),0), put_value(y(0),0), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(4)), put_integer(8,0), put_value(y(0),1), call('$sys_var_put'/2), put_value(y(0),0), deallocate, execute('$unwind'/1), label(1), trust_me_else_fail, call_c('Pl_Set_Bip_Name_2',[],[x(2),x(3)]), execute('$pl_err_instantiation'/0)]). predicate(system:'$unwind'/1,61,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), put_integer(7,0), put_variable(y(1),1), call('$sys_var_read'/2), put_value(y(0),0), put_unsafe_value(y(1),1), call_c('Pl_Throw_2',[],[x(0),x(1)]), fail]). predicate(system:'$throw_internal'/3,69,static,private,monofile,built_in,[ call_c('Pl_Call_Info_Bip_Name_1',[],[x(2)]), put_variable(x(2),4), put_variable(x(3),5), call_c('Pl_Get_Bip_Name_2',[],[x(4),x(5)]), execute('$throw'/4)]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/dec10io.wam����������������������������������������������������������������0000644�0001750�0001750�00000027016�13021356407�015243� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : dec10io.pl file_name('/home/diaz/GP/src/BipsPl/dec10io.pl'). predicate(system:'$use_dec10io'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:'$find_existing_stream'/3,45,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(11), switch_on_term(3,1,fail,fail,fail), label(1), switch_on_atom([(user,2),(user_input,6),(user_output,10)]), label(2), try(4), trust(8), label(3), try_me_else(5), label(4), get_atom(user,0), get_structure('$stream'/1,1), unify_integer(0), get_atom(input,2), proceed, label(5), retry_me_else(7), label(6), get_atom(user_input,0), get_structure('$stream'/1,1), unify_integer(0), get_atom(input,2), proceed, label(7), retry_me_else(9), label(8), get_atom(user,0), get_structure('$stream'/1,1), unify_integer(1), get_atom(output,2), proceed, label(9), trust_me_else_fail, label(10), get_atom(user_output,0), get_structure('$stream'/1,1), unify_integer(1), get_atom(output,2), proceed, label(11), retry_me_else(12), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_structure('$dec10_stream'/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(y(2)), put_meta_term(system,0,0), put_void(1), call(clause/2), cut(y(3)), put_value(y(1),0), put_value(y(0),1), put_value(y(2),2), deallocate, execute('$$find_existing_stream/3_$aux1'/3), label(12), trust_me_else_fail, allocate(2), get_variable(y(0),0), get_value(y(0),1), get_variable(y(1),2), put_value(y(0),0), get_structure('$stream'/1,0), unify_variable(x(0)), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_value(y(0),0), call(current_stream/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute(stream_property/2)]). predicate(system:'$$find_existing_stream/3_$aux1'/3,53,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), call(current_stream/1), put_value(y(0),0), put_structure(file_name/1,1), unify_local_value(y(1)), call(stream_property/2), put_value(y(0),0), put_value(y(2),1), call(stream_property/2), cut(y(3)), deallocate, proceed, label(1), trust_me_else_fail, allocate(0), put_structure('$dec10_stream'/3,3), unify_local_value(x(1)), unify_local_value(x(0)), unify_local_value(x(2)), put_meta_term(system,3,0), call(retract/1), fail]). predicate(system:see/1,73,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[see,1]), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(y(0)), put_variable(y(1),1), call('$see/1_$aux1'/2), cut(y(0)), put_unsafe_value(y(1),0), deallocate, execute(set_input/1), label(1), trust_me_else_fail, execute('$pl_err_instantiation'/0)]). predicate(system:'$see/1_$aux1'/2,73,static,private,monofile,local,[ try_me_else(1), put_atom(input,2), execute('$find_existing_stream'/3), label(1), trust_me_else_fail, allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[see,1]), put_value(y(0),0), put_atom(read,1), put_value(y(1),2), put_nil(3), call('$open'/4), put_structure('$dec10_stream'/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_atom(input), put_meta_term(system,0,0), deallocate, execute(assertz/1)]). predicate(system:seeing/1,89,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(3), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[seeing,1]), put_variable(y(2),0), call(current_input/1), put_value(y(0),0), put_value(y(2),1), put_atom(input,2), call('$find_existing_stream'/3), cut(y(1)), deallocate, proceed]). predicate(system:seen/0,97,static,private,monofile,built_in,[ pragma_arity(1), get_current_choice(x(0)), allocate(2), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[seen,0]), put_variable(y(1),0), call(current_input/1), put_value(y(1),0), call(close/1), put_value(y(1),0), call('$seen/0_$aux1'/1), cut(y(0)), deallocate, proceed]). predicate(system:'$seen/0_$aux1'/1,97,static,private,monofile,local,[ try_me_else(1), put_value(x(0),1), put_void(0), put_atom(input,2), execute('$find_existing_stream'/3), label(1), trust_me_else_fail, proceed]). predicate(system:tell/1,107,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[tell,1]), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(y(0)), put_variable(y(1),1), call('$tell/1_$aux1'/2), cut(y(0)), put_unsafe_value(y(1),0), deallocate, execute(set_output/1), label(1), trust_me_else_fail, execute('$pl_err_instantiation'/0)]). predicate(system:'$tell/1_$aux1'/2,107,static,private,monofile,local,[ try_me_else(1), put_atom(output,2), execute('$find_existing_stream'/3), label(1), trust_me_else_fail, allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[tell,1]), put_value(y(0),0), put_atom(write,1), put_value(y(1),2), put_nil(3), call('$open'/4), put_structure('$dec10_stream'/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_atom(output), put_meta_term(system,0,0), deallocate, execute(assertz/1)]). predicate(system:telling/1,123,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(3), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[telling,1]), put_variable(y(2),0), call(current_output/1), put_value(y(0),0), put_value(y(2),1), put_atom(output,2), call('$find_existing_stream'/3), cut(y(1)), deallocate, proceed]). predicate(system:told/0,131,static,private,monofile,built_in,[ pragma_arity(1), get_current_choice(x(0)), allocate(2), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[told,0]), put_variable(y(1),0), call(current_output/1), put_value(y(1),0), call(close/1), put_value(y(1),0), call('$told/0_$aux1'/1), cut(y(0)), deallocate, proceed]). predicate(system:'$told/0_$aux1'/1,131,static,private,monofile,local,[ try_me_else(1), put_value(x(0),1), put_void(0), put_atom(output,2), execute('$find_existing_stream'/3), label(1), trust_me_else_fail, proceed]). predicate(system:append/1,140,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(2), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[append,1]), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(y(0)), put_variable(y(1),1), call('$append/1_$aux1'/2), cut(y(0)), put_unsafe_value(y(1),0), deallocate, execute(set_output/1), label(1), trust_me_else_fail, execute('$pl_err_instantiation'/0)]). predicate(system:'$append/1_$aux1'/2,140,static,private,monofile,local,[ try_me_else(1), put_atom(output,2), execute('$find_existing_stream'/3), label(1), trust_me_else_fail, allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[append,1]), put_value(y(0),0), put_atom(append,1), put_value(y(1),2), put_nil(3), call('$open'/4), put_structure('$dec10_stream'/3,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_atom(output), put_meta_term(system,0,0), deallocate, execute(assertz/1)]). predicate(system:get0/1,156,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get0,1]), call_c('Pl_Get_Code_1',[boolean],[x(0)]), proceed]). predicate(system:get/1,162,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get,1]), put_value(y(0),0), call('$check_in_character_code'/1), put_variable(x(0),1), call_c('Pl_Get_Code_1',[boolean],[x(1)]), put_value(y(0),1), deallocate, execute('$get/1_$aux1'/2)]). predicate(system:'$get/1_$aux1'/2,162,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[=<,2]), math_load_value(x(0),0), put_integer(32,3), call_c('Pl_Blt_Lte',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), put_value(x(1),0), execute(get/1), label(1), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(system:put/1,171,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[put,1]), call_c('Pl_Put_Code_1',[],[x(0)]), proceed]). predicate(system:skip/1,176,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[skip,1]), put_value(y(0),0), call('$check_in_character_code'/1), call(repeat/0), put_variable(x(0),1), call_c('Pl_Get_Code_1',[boolean],[x(1)]), get_value(y(0),0), cut(y(1)), deallocate, proceed]). predicate(system:'$check_in_character_code'/1,186,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), retry_me_else(2), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$$check_in_character_code/1_$aux1'/1), label(2), trust_me_else_fail, put_value(x(0),1), put_atom(integer,0), execute('$pl_err_type'/2)]). predicate(system:'$$check_in_character_code/1_$aux1'/1,189,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>=,2]), math_load_value(x(0),2), put_integer(-1,3), call_c('Pl_Blt_Gte',[fast_call,boolean],[x(2),x(3)]), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[=<,2]), math_load_value(x(0),0), put_integer(255,2), call_c('Pl_Blt_Lte',[fast_call,boolean],[x(0),x(2)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_atom(in_character_code,0), execute('$pl_err_representation'/1)]). predicate(system:tab/1,201,static,private,monofile,built_in,[ try_me_else(1), allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[tab,1]), put_variable(y(0),1), call('$arith_eval'/2), put_void(0), put_integer(1,1), put_value(y(0),2), call(for/3), put_atom(' ',0), call(put_char/1), fail, label(1), trust_me_else_fail, proceed]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/callinf_supp.c�������������������������������������������������������������0000644�0001750�0001750�00000012534�13021324543�016127� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : callinf_supp.c * * Descr.: meta call info support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static PlLong save_call_info; /* 'int' is enough in fact */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_MAKE_CALL_INFO * * * *-------------------------------------------------------------------------*/ PlLong Pl_Make_Call_Info(WamWord func_word, WamWord arity_word, WamWord debug_call_word) { int func, arity; Bool debug_call; func = Pl_Rd_Atom(func_word); arity = Pl_Rd_Integer(arity_word); debug_call = Pl_Rd_Integer(debug_call_word); return Call_Info(func, arity, debug_call); } /*-------------------------------------------------------------------------* * PL_SAVE_CALL_INFO_3 * * * *-------------------------------------------------------------------------*/ void Pl_Save_Call_Info_3(WamWord func_word, WamWord arity_word, WamWord debug_call_word) { save_call_info = Pl_Make_Call_Info(func_word, arity_word, debug_call_word); } /*-------------------------------------------------------------------------* * PL_LOAD_CALL_INFO_ARG_1 * * * *-------------------------------------------------------------------------*/ void Pl_Load_Call_Info_Arg_1(WamWord arg_no_word) { int arg_no; arg_no = Pl_Rd_Integer(arg_no_word); A(arg_no) = Tag_INT(save_call_info); } /*-------------------------------------------------------------------------* * PL_CALL_INFO_BIP_NAME_1 * * * *-------------------------------------------------------------------------*/ void Pl_Call_Info_Bip_Name_1(WamWord call_info_word) { PlLong call_info; int func, arity; call_info = UnTag_INT(call_info_word) >> 1; func = Functor_Of(call_info); arity = Arity_Of(call_info); Pl_Set_Bip_Name_2(Tag_ATM(func), Tag_INT(arity)); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/file_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000020234�13021324543�014665� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : file_c.c * * Descr.: file name management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #include "engine_pl.h" #include "bips_pl.h" #ifdef _WIN32 #include <io.h> #else #include <unistd.h> #include <sys/param.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static char *Find_Suffix(char *suffixes, char *suffix); /*-------------------------------------------------------------------------* * PL_ABSOLUTE_FILE_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Absolute_File_Name_2(WamWord path1_word, WamWord path2_word) { char *path1, *path2; path1 = pl_atom_tbl[Pl_Rd_Atom_Check(path1_word)].name; path2 = Pl_M_Absolute_Path_Name(path1); if (path2 == NULL) Pl_Err_Domain(pl_domain_os_path, path1_word); return Pl_Un_String_Check(path2, path2_word); } /*-------------------------------------------------------------------------* * PL_IS_ABSOLUTE_FILE_NAME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Is_Absolute_File_Name_1(WamWord path_word) { char *path = pl_atom_tbl[Pl_Rd_Atom_Check(path_word)].name; return Pl_M_Is_Absolute_File_Name(path); } /*-------------------------------------------------------------------------* * PL_IS_RELATIVE_FILE_NAME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Is_Relative_File_Name_1(WamWord path_word) { return !Pl_Is_Absolute_File_Name_1(path_word); } /*-------------------------------------------------------------------------* * PL_DECOMPOSE_FILE_NAME_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Decompose_File_Name_4(WamWord path_word, WamWord dir_word, WamWord prefix_word, WamWord suffix_word) { char *path = pl_atom_tbl[Pl_Rd_Atom_Check(path_word)].name; char *dir, *base, *suffix; char c; Pl_Check_For_Un_Atom(dir_word); Pl_Check_For_Un_Atom(prefix_word); Pl_Check_For_Un_Atom(suffix_word); dir = Pl_M_Decompose_File_Name(path, FALSE, &base, &suffix); if (!Pl_Un_String(dir, dir_word)) return FALSE; c = *suffix; *suffix = '\0'; if (!Pl_Un_String(base, prefix_word)) return FALSE; *suffix = c; return Pl_Un_String(suffix, suffix_word); } /*-------------------------------------------------------------------------* * PL_PROLOG_FILE_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Prolog_File_Name_2(WamWord path1_word, WamWord path2_word) { int atom; char *path1; int len; char *p, *q; char suffixes[] = "|" PROLOG_FILE_SUFFIX PROLOG_FILE_SUFFIXES_ALT; atom = Pl_Rd_Atom_Check(path1_word); path1 = pl_atom_tbl[atom].name; path1 = Pl_M_Absolute_Path_Name(path1); if (path1 == NULL) Pl_Err_Domain(pl_domain_os_path, path1_word); if (strcmp(path1, "user") == 0) { same: return Pl_Un_Atom_Check(atom, path2_word); } Find_Last_Dir_Sep(p, path1); if (strchr((p) ? p : path1, '.')) goto same; strcpy(pl_glob_buff, path1); len = strlen(path1); q = suffixes; do { p = q + 1; if (*p == '\0') /* no more suffixes: set default one */ { p = PROLOG_FILE_SUFFIX; break; } q = strchr(p, '|'); *q = '\0'; strcpy(pl_glob_buff + len, p); } while(access(pl_glob_buff, F_OK)); /* while not found */ sprintf(pl_glob_buff, "%s%s", pl_atom_tbl[atom].name, p); return Pl_Un_String_Check(pl_glob_buff, path2_word); } /*-------------------------------------------------------------------------* * PL_PROLOG_FILE_SUFFIX_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Prolog_File_Suffix_1(WamWord suffix_word) { int atom; char *suffix; atom = Pl_Rd_Atom_Check(suffix_word); suffix = pl_atom_tbl[atom].name; return Find_Suffix("|" PROLOG_FILE_SUFFIX PROLOG_FILE_SUFFIXES_ALT, suffix) != NULL; } /*-------------------------------------------------------------------------* * FIND_SUFFIX * * * *-------------------------------------------------------------------------*/ static char * Find_Suffix(char *suffixes, char *suffix) { char *p; /* TODO: use strcasestr (must be tested in configure.in) */ if ((p = strstr(suffixes, suffix)) && p[-1] == '|' && p[strlen(suffix)] == '|') return p; return NULL; } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/consult_c.c����������������������������������������������������������������0000644�0001750�0001750�00000013741�13021324543�015442� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : consult_c.c * * Descr.: file consulting - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <errno.h> #include <sys/types.h> #include "engine_pl.h" #include "bips_pl.h" #include "linedit.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #if 1 /*-------------------------------------------------------------------------* * PL_CONSULT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Consult_2(WamWord tmp_file_word, WamWord pl_file_word) { char *tmp_file = Pl_Rd_String_Check(tmp_file_word); char *pl_file = Pl_Rd_String_Check(pl_file_word); StmInf *pstm_o = pl_stm_tbl[pl_stm_top_level_output]; StmInf *pstm_i = pl_stm_tbl[pl_stm_top_level_input]; int pid; FILE *f_out, *f_in; FILE **pf_in; PlLong save; unsigned char *p = NULL; int status, c; int save_use_le_prompt; char *arg[] = { "pl2wam", "-w", "--compile-msg", "--no-redef-error", "--pl-state", tmp_file, "-o", tmp_file, pl_file, NULL, NULL, NULL, NULL }; /* 3 warnings + 1 for terminal NULL */ int warn_i = sizeof(arg) / sizeof(arg[0]) - 4; /* the 4 NULL */ #define ADD_WARN(flag, opt_str) if (!Flag_Value(flag)) arg[warn_i++] = opt_str ADD_WARN(suspicious_warning, "--no-susp-warn"); ADD_WARN(singleton_warning, "--no-singl-warn"); ADD_WARN(multifile_warning, "--no-mult-warn"); save = SYS_VAR_SAY_GETC; #ifndef NO_USE_PIPED_STDIN_FOR_CONSULT SYS_VAR_SAY_GETC = 1; pf_in = &f_in; #else f_in = NULL; pf_in = NULL; #endif Pl_Write_Pl_State_File(tmp_file_word); SYS_VAR_SAY_GETC = save; Pl_Flush_All_Streams(); pid = Pl_M_Spawn_Redirect(arg, 0, pf_in, &f_out, &f_out); /* If pl2wam is not found we get ENOENT under Windows. * Under Unix the information is only obtained at Pl_M_Get_Status(). */ if (pid == -1 && errno != ENOENT) Os_Test_Error(pid); /* ENOENT is for Windows */ if (pid < 0) { error_pl2wam: Pl_Err_System(Pl_Create_Atom("error trying to execute pl2wam " "(maybe not found)")); return FALSE; } save_use_le_prompt = pl_use_le_prompt; pl_use_le_prompt = 0; for (;;) { #if 1 c = fgetc(f_out); #else char c0; c = (read(fileno(f_out), &c0, 1) == 1) ? c0 : EOF; #endif if (c == EOF) break; #ifndef NO_USE_PIPED_STDIN_FOR_CONSULT if (c == CHAR_TO_EMIT_WHEN_CHAR) { if (p == NULL) { c = Pl_Stream_Getc(pstm_i); if (c == EOF) { eof_reached: p = (unsigned char *) "end_of_file.\n"; c = *p++; } } else { if (*p == '\0') goto eof_reached; else c = *p++; } fputc(c, f_in); fflush(f_in); continue; } #endif Pl_Stream_Putc(c, pstm_o); } pl_use_le_prompt = save_use_le_prompt; if (f_in) fclose(f_in); fclose(f_out); status = Pl_M_Get_Status(pid); if (status < 0) goto error_pl2wam; return status == 0; } #endif �������������������������������gprolog-1.4.5/src/BipsPl/no_le_interf.pl������������������������������������������������������������0000644�0001750�0001750�00000005456�13021324543�016311� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : no_le_interf.pl * * Descr.: no linedit interface management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_le_interf'. '$get_linedit_prompt'(_). '$set_linedit_prompt'(_). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/sockets.wam����������������������������������������������������������������0000644�0001750�0001750�00000007613�13021356407�015473� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : sockets.pl file_name('/home/diaz/GP/src/BipsPl/sockets.pl'). predicate(system:'$use_sockets'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:socket/2,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket,2]), call_c('Pl_Socket_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:socket_close/1,51,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket_close,1]), call_c('Pl_Socket_Close_1',[boolean],[x(0)]), proceed]). predicate(system:socket_bind/2,58,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket_bind,2]), call_c('Pl_Socket_Bind_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:socket_connect/4,65,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket_connect,4]), put_value(x(2),0), put_variable(y(3),1), call('$get_open_stm'/2), put_value(y(2),0), put_variable(y(4),1), call('$get_open_stm'/2), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), deallocate, call_c('Pl_Socket_Connect_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:socket_listen/2,74,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket_listen,2]), call_c('Pl_Socket_Listen_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:socket_accept/3,81,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket_accept,3]), put_value(x(1),0), put_variable(y(2),1), call('$get_open_stm'/2), put_value(y(1),0), put_variable(y(3),1), call('$get_open_stm'/2), put_value(y(0),0), put_void(1), put_unsafe_value(y(2),2), put_unsafe_value(y(3),3), deallocate, call_c('Pl_Socket_Accept_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:socket_accept/4,88,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[socket_accept,4]), put_value(y(1),0), call('$socket_accept/4_$aux1'/1), put_value(y(2),0), put_variable(y(4),1), call('$get_open_stm'/2), put_value(y(3),0), put_variable(y(5),1), call('$get_open_stm'/2), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(4),2), put_unsafe_value(y(5),3), deallocate, call_c('Pl_Socket_Accept_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$socket_accept/4_$aux1'/1,88,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, execute('$pl_err_uninstantiation'/1)]). predicate(system:'$assoc_socket_streams'/3,101,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],['$assoc_socket_streams',3]), put_value(x(1),0), put_variable(y(2),1), call('$get_open_stm'/2), put_value(y(1),0), put_variable(y(3),1), call('$get_open_stm'/2), put_value(y(0),0), put_unsafe_value(y(2),1), put_unsafe_value(y(3),2), deallocate, call_c('Pl_Assoc_Socket_Streams_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:hostname_address/2,110,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[hostname_address,2]), call_c('Pl_Hostname_Address_2',[boolean],[x(0),x(1)]), proceed]). ���������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/expand.wam�����������������������������������������������������������������0000644�0001750�0001750�00000006742�13021356407�015301� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : expand.pl file_name('/home/diaz/GP/src/BipsPl/expand.pl'). predicate(system:'$use_expand'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:expand_term/2,48,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),1), put_variable(y(1),1), call('$expand_term1'/2), put_unsafe_value(y(1),0), get_value(y(0),0), deallocate, proceed]). predicate(system:'$expand_term1'/2,52,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(1), get_variable(y(0),2), call('$$expand_term1/2_$aux1'/2), cut(y(0)), deallocate, proceed]). predicate(system:'$$expand_term1/2_$aux1'/2,52,static,private,monofile,local,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), get_value(x(0),1), proceed, label(1), retry_me_else(2), execute('$call_term_expansion'/2), label(2), retry_me_else(3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[expand_term,2]), execute('$dcg_trans_rule'/2), label(3), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(system:'$call_term_expansion'/2,64,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_structure((/)/2,0), unify_atom(term_expansion), unify_integer(2), put_meta_term(system,0,0), call('$current_predicate'/1), put_structure(term_expansion/2,0), unify_local_value(y(0)), unify_local_value(y(1)), put_atom(system,1), put_atom('$call_term_expansion',2), put_integer(2,3), deallocate, execute('$call'/4)]). predicate(system:phrase/2,74,static,private,monofile,built_in,[ put_nil(2), put_integer(2,3), execute('$phrase'/4)]). predicate(system:phrase/3,80,static,private,monofile,built_in,[ put_integer(3,3), execute('$phrase'/4)]). predicate(system:'$phrase'/4,86,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_atom(phrase,0), put_value(y(3),1), call_c('Pl_Set_Bip_Name_2',[],[x(0),x(1)]), put_value(y(0),0), call('$$phrase/4_$aux1'/1), put_value(y(0),0), put_value(y(1),1), put_variable(y(4),2), put_variable(y(5),3), call('$dcg_trans_body'/4), put_value(y(5),0), put_atom(user,1), put_atom(phrase,2), put_value(y(3),3), call('$call'/4), put_value(y(2),0), get_value(y(4),0), deallocate, proceed]). predicate(system:'$$phrase/4_$aux1'/1,86,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, proceed]). predicate(system:'$dcg_trans_rule'/2,102,static,private,monofile,built_in,[ call_c('Pl_Dcg_Trans_Rule_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$dcg_trans_body'/4,108,static,private,monofile,built_in,[ call_c('Pl_Dcg_Trans_Body_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). directive(71,system,[ put_atom(user,0), put_structure(phrase/2,1), unify_integer(2), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(72,system,[ put_atom(user,0), put_structure(phrase/3,1), unify_integer(2), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). ������������������������������gprolog-1.4.5/src/BipsPl/le_interf.pl���������������������������������������������������������������0000644�0001750�0001750�00000007072�13021324543�015611� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : le_interf.pl * * Descr.: linedit interface management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_le_interf'. get_linedit_prompt(Prompt) :- set_bip_name(get_linedit_prompt, 1), '$call_c_test'('Pl_Get_Linedit_Prompt_1'(Prompt)). '$get_linedit_prompt'(Prompt) :- '$call_c_test'('Pl_Get_Linedit_Prompt_1'(Prompt)). set_linedit_prompt(Prompt) :- set_bip_name(set_linedit_prompt, 1), '$call_c'('Pl_Set_Linedit_Prompt_1'(Prompt)). '$set_linedit_prompt'(Prompt) :- '$call_c'('Pl_Set_Linedit_Prompt_1'(Prompt)). add_linedit_completion(Compl) :- set_bip_name(add_linedit_completion, 1), '$call_c_test'('Pl_Add_Linedit_Completion_1'(Compl)). find_linedit_completion(Prefix, Compl) :- set_bip_name(find_linedit_completion, 2), '$call_c_test'('Pl_Find_Linedit_Completion_2'(Prefix, Compl)). '$find_linedit_completion_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Find_Linedit_Completion_Alt_0'). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/all_solut.pl���������������������������������������������������������������0000644�0001750�0001750�00000012423�13021324543�015634� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : all_solut.pl * * Descr.: all solution collector management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_all_solut'. :- meta_predicate(findall(?, 0, -)). :- meta_predicate(findall(?, 0, -, ?)). :- meta_predicate(bagof(?, 0, -)). :- meta_predicate(setof(?, 0, -)). findall(Template, MGenerator, Instances) :- '$check_list_arg'(Instances, findall, 3), '$strip_module_nonvar'(MGenerator, Module, Generator), '$findall'(Template, Generator, Module, Instances, [], findall, 3). findall(Template, MGenerator, Instances, Tail) :- '$check_list_arg'(Instances, findall, 4), '$strip_module_nonvar'(MGenerator, Module, Generator), '$findall'(Template, Generator, Module, Instances, Tail, findall, 4). '$findall'(Template, Generator, Module, Instances, Tail, Func, Arity) :- '$store_solutions'(Template, Generator, Module, Stop, Func, Arity), '$call_c_test'('Pl_Recover_Solutions_4'(Stop, 0, Instances, Tail)). setof(Template, MGenerator, Instances) :- '$check_list_arg'(Instances, setof, 3), '$strip_module_nonvar'(MGenerator, Module, Generator), '$bagof'(Template, Generator, Module, Instances, setof, 3). % sort(Instances). bagof(Template, MGenerator, Instances) :- '$check_list_arg'(Instances, bagof, 3), '$strip_module_nonvar'(MGenerator, Module, Generator), '$bagof'(Template, Generator, Module, Instances, bagof, 3). '$bagof'(Template, Generator, Module, Instances, Func, Arity) :- '$call_c_test'('Pl_Free_Variables_4'(Template, Generator, Generator1, Key)), !, '$store_solutions'(Key - Template, Generator1, Module, Stop, Func, Arity), set_bip_name(Func, Arity), % for error too_many_variables in C function '$call_c_test'('Pl_Recover_Solutions_4'(Stop, 1, AllInstances, [])), ( Func = bagof -> keysort(AllInstances) ; sort(AllInstances) ), '$group_solutions'(AllInstances, Key, Instances). '$bagof'(Template, _, Module, Instances, Func, Arity) :- '$call_c'('Pl_Recover_Generator_1'(Generator)), '$findall'(Template, Generator, Module, Instances, [], Func, Arity), Instances \== [], ( Func = bagof -> true ; sort(Instances) ). '$store_solutions'(Template, Generator, Module, Stop, Func, Arity) :- '$call_c'('Pl_Stop_Mark_1'(Stop)), ( '$call'(Generator, Module, Func, Arity), '$call_c'('Pl_Store_Solution_1'(Template)), fail ; true ). '$group_solutions'(AllInstances1, Key, Instances) :- '$call_c_test'('Pl_Group_Solutions_3'(AllInstances1, Key, Instances)). '$group_solutions_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Group_Solutions_Alt_0'). % Args testing '$check_list_arg'(List, Func, Arity) :- set_bip_name(Func, Arity), '$check_list_or_partial_list'(List). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/random.wam�����������������������������������������������������������������0000644�0001750�0001750�00000002062�13021356407�015271� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : random.pl file_name('/home/diaz/GP/src/BipsPl/random.pl'). predicate(system:'$use_random'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:randomize/0,45,static,private,monofile,built_in,[ call_c('Pl_M_Randomize',[],[]), proceed]). predicate(system:set_seed/1,51,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_seed,1]), call_c('Pl_Set_Seed_1',[],[x(0)]), proceed]). predicate(system:get_seed/1,58,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_seed,1]), call_c('Pl_Get_Seed_1',[boolean],[x(0)]), proceed]). predicate(system:random/1,65,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[random,1]), call_c('Pl_Random_1',[],[x(0)]), proceed]). predicate(system:random/3,72,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[random,3]), call_c('Pl_Random_3',[boolean],[x(0),x(1),x(2)]), proceed]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/call_args_c.c��������������������������������������������������������������0000644�0001750�0001750�00000013077�13021324543�015704� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : call_args_c.c * * Descr.: meta call management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #define OBJ_INIT Call_Args_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int atom_call_with_args; static int atom_call; /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * CALL_ARGS_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Call_Args_Initializer(void) { atom_call_with_args = Pl_Create_Atom("call_with_args"); atom_call = Pl_Create_Atom("call"); } /*-------------------------------------------------------------------------* * CALL_CLOSURE * * * *-------------------------------------------------------------------------*/ WamCont Pl_Call_Closure(int atom_bip, int arity_rest) { int caller_func = atom_bip; int caller_arity = arity_rest + 1; int module, func, arity_clos, arity; WamWord goal_word; WamWord *arg_adr; #if 0 PredInf *pred; WamWord *w; int i; #endif Pl_Set_C_Bip_Name(pl_atom_tbl[caller_func].name, caller_arity); module = Pl_Strip_Module_Top(A(0), FALSE, TRUE, &goal_word); if (atom_bip == atom_call_with_args) { func = Pl_Rd_Atom_Check(goal_word); arity_clos = 0; } else { arg_adr = Pl_Rd_Callable_Check(goal_word, &func, &arity_clos); } arity = arity_clos + arity_rest; if (arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); Pl_Unset_C_Bip_Name(); /* arity = arity_clos + arity_rest */ /* the arity_clos args in the compound term go in A(0)..A(arity_clos-1) */ /* the arity_rest args in A(1)..A(arity_rest) go in A(arity_clos)..A(arity-1) */ /* first copy the arity_rest args (to avoid the overwrite them copying closure args first) */ /* NB: if arity_clos == 0 then dst < src */ /* if arity_clos == 1 then dst == src (optim) */ /* if arity_clos >= 2 then dst > src */ /* we use memmove */ if (arity_clos != 1) /* optim: no copy needed when closure has 1 arg */ memmove(&A(arity_clos), &A(1), sizeof(WamWord) * arity_rest); /* then copy the arity_clos args */ memcpy((void *) &A(0), arg_adr, sizeof(WamWord) * arity_clos); return Pl_BC_Call_Initial(module, func, arity, &A(0), NOT_A_WAM_WORD, caller_func, caller_arity, TRUE); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/type_inl.pl����������������������������������������������������������������0000644�0001750�0001750�00000006547�13021324543�015473� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : type_inl.pl * * Descr.: type testing (inline) management - defs for meta-call * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_type_inl'. var(X) :- var(X). nonvar(X) :- nonvar(X). atom(X) :- atom(X). integer(X) :- integer(X). float(X) :- float(X). number(X) :- number(X). atomic(X) :- atomic(X). compound(X) :- compound(X). callable(X) :- callable(X). ground(X) :- ground(X). is_list(X) :- is_list(X). list(X) :- list(X). partial_list(X) :- partial_list(X). list_or_partial_list(X) :- list_or_partial_list(X). :- built_in_fd(fd_var / 1, non_fd_var / 1, generic_var / 1, non_generic_var / 1). fd_var(X) :- fd_var(X). non_fd_var(X) :- non_fd_var(X). generic_var(X) :- generic_var(X). non_generic_var(X) :- non_generic_var(X). ���������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/char_io_c.c����������������������������������������������������������������0000644�0001750�0001750�00000045317�13021324543�015363� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : char_io_c.c * * Descr.: character input-output management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_GET_KEY_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Key_2(WamWord sora_word, WamWord code_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Check_For_Un_Integer(code_word); c = Pl_Stream_Get_Key(pl_stm_tbl[stm], TRUE, TRUE); if (c == EOF) c = -1; return Pl_Get_Integer(c, code_word); } /*-------------------------------------------------------------------------* * PL_GET_KEY_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Key_1(WamWord code_word) { return Pl_Get_Key_2(NOT_A_WAM_WORD, code_word); } /*-------------------------------------------------------------------------* * PL_GET_KEY_NO_ECHO_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Key_No_Echo_2(WamWord sora_word, WamWord code_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Check_For_Un_Integer(code_word); c = Pl_Stream_Get_Key(pl_stm_tbl[stm], FALSE, TRUE); if (c == EOF) c = -1; return Pl_Get_Integer(c, code_word); } /*-------------------------------------------------------------------------* * PL_GET_KEY_NO_ECHO_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Key_No_Echo_1(WamWord code_word) { return Pl_Get_Key_No_Echo_2(NOT_A_WAM_WORD, code_word); } /*-------------------------------------------------------------------------* * PL_GET_CHAR_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Char_2(WamWord sora_word, WamWord char_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Check_For_Un_In_Char(char_word); c = Pl_Stream_Getc(pl_stm_tbl[stm]); if (c != EOF && !Is_Valid_Code(c)) Pl_Err_Representation(pl_representation_character); return Pl_Get_Atom((c == EOF) ? pl_atom_end_of_file : ATOM_CHAR(c), char_word); } /*-------------------------------------------------------------------------* * PL_GET_CHAR_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Char_1(WamWord char_word) { return Pl_Get_Char_2(NOT_A_WAM_WORD, char_word); } /*-------------------------------------------------------------------------* * PL_GET_CODE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Code_2(WamWord sora_word, WamWord code_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Check_For_Un_In_Code(code_word); c = Pl_Stream_Getc(pl_stm_tbl[stm]); if (c != EOF && !Is_Valid_Code(c)) Pl_Err_Representation(pl_representation_character); if (c == EOF) c = -1; return Pl_Get_Integer(c, code_word); } /*-------------------------------------------------------------------------* * PL_GET_CODE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Code_1(WamWord code_word) { return Pl_Get_Code_2(NOT_A_WAM_WORD, code_word); } /*-------------------------------------------------------------------------* * PL_GET_BYTE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Byte_2(WamWord sora_word, WamWord byte_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, FALSE, TRUE); Pl_Check_For_Un_In_Byte(byte_word); c = Pl_Stream_Getc(pl_stm_tbl[stm]); if (c == EOF) c = -1; return Pl_Get_Integer(c, byte_word); } /*-------------------------------------------------------------------------* * PL_GET_BYTE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Byte_1(WamWord byte_word) { return Pl_Get_Byte_2(NOT_A_WAM_WORD, byte_word); } /*-------------------------------------------------------------------------* * PL_UNGET_CHAR_2 * * * *-------------------------------------------------------------------------*/ void Pl_Unget_Char_2(WamWord sora_word, WamWord char_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Stream_Ungetc(Pl_Rd_Char_Check(char_word), pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_UNGET_CHAR_1 * * * *-------------------------------------------------------------------------*/ void Pl_Unget_Char_1(WamWord char_word) { Pl_Unget_Char_2(NOT_A_WAM_WORD, char_word); } /*-------------------------------------------------------------------------* * PL_UNGET_CODE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Unget_Code_2(WamWord sora_word, WamWord code_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Stream_Ungetc(Pl_Rd_Code_Check(code_word), pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_UNGET_CODE_1 * * * *-------------------------------------------------------------------------*/ void Pl_Unget_Code_1(WamWord code_word) { Pl_Unget_Code_2(NOT_A_WAM_WORD, code_word); } /*-------------------------------------------------------------------------* * PL_UNGET_BYTE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Unget_Byte_2(WamWord sora_word, WamWord byte_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, FALSE, TRUE); Pl_Stream_Ungetc(Pl_Rd_Byte_Check(byte_word), pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_UNGET_BYTE_1 * * * *-------------------------------------------------------------------------*/ void Pl_Unget_Byte_1(WamWord byte_word) { Pl_Unget_Byte_2(NOT_A_WAM_WORD, byte_word); } /*-------------------------------------------------------------------------* * PL_PEEK_CHAR_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Peek_Char_2(WamWord sora_word, WamWord char_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Check_For_Un_In_Char(char_word); c = Pl_Stream_Peekc(pl_stm_tbl[stm]); if (c != EOF && !Is_Valid_Code(c)) Pl_Err_Representation(pl_representation_character); return Pl_Get_Atom((c == EOF) ? pl_atom_end_of_file : ATOM_CHAR(c), char_word); } /*-------------------------------------------------------------------------* * PL_PEEK_CHAR_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Peek_Char_1(WamWord char_word) { return Pl_Peek_Char_2(NOT_A_WAM_WORD, char_word); } /*-------------------------------------------------------------------------* * PL_PEEK_CODE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Peek_Code_2(WamWord sora_word, WamWord code_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, TRUE); Pl_Check_For_Un_In_Code(code_word); c = Pl_Stream_Peekc(pl_stm_tbl[stm]); if (c != EOF && !Is_Valid_Code(c)) Pl_Err_Representation(pl_representation_character); if (c == EOF) c = -1; return Pl_Get_Integer(c, code_word); } /*-------------------------------------------------------------------------* * PL_PEEK_CODE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Peek_Code_1(WamWord code_word) { return Pl_Peek_Code_2(NOT_A_WAM_WORD, code_word); } /*-------------------------------------------------------------------------* * PL_PEEK_BYTE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Peek_Byte_2(WamWord sora_word, WamWord byte_word) { int stm; int c; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); pl_last_input_sora = sora_word; Pl_Check_Stream_Type(stm, FALSE, TRUE); Pl_Check_For_Un_In_Byte(byte_word); c = Pl_Stream_Peekc(pl_stm_tbl[stm]); if (c == EOF) c = -1; return Pl_Get_Integer(c, byte_word); } /*-------------------------------------------------------------------------* * PL_PEEK_BYTE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Peek_Byte_1(WamWord byte_word) { return Pl_Peek_Byte_2(NOT_A_WAM_WORD, byte_word); } /*-------------------------------------------------------------------------* * PL_PUT_CHAR_2 * * * *-------------------------------------------------------------------------*/ void Pl_Put_Char_2(WamWord sora_word, WamWord char_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); Pl_Stream_Putc(Pl_Rd_Char_Check(char_word), pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_PUT_CHAR_1 * * * *-------------------------------------------------------------------------*/ void Pl_Put_Char_1(WamWord char_word) { Pl_Put_Char_2(NOT_A_WAM_WORD, char_word); } /*-------------------------------------------------------------------------* * PL_PUT_CODE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Put_Code_2(WamWord sora_word, WamWord code_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); Pl_Stream_Putc(Pl_Rd_Code_Check(code_word), pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_PUT_CODE_1 * * * *-------------------------------------------------------------------------*/ void Pl_Put_Code_1(WamWord code_word) { Pl_Put_Code_2(NOT_A_WAM_WORD, code_word); } /*-------------------------------------------------------------------------* * PL_PUT_BYTE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Put_Byte_2(WamWord sora_word, WamWord byte_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, FALSE, FALSE); Pl_Stream_Putc(Pl_Rd_Byte_Check(byte_word), pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_PUT_BYTE_1 * * * *-------------------------------------------------------------------------*/ void Pl_Put_Byte_1(WamWord byte_word) { Pl_Put_Byte_2(NOT_A_WAM_WORD, byte_word); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/atom.wam�������������������������������������������������������������������0000644�0001750�0001750�00000016457�13021356407�014766� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : atom.pl file_name('/home/diaz/GP/src/BipsPl/atom.pl'). predicate(system:'$use_atom'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:atom_length/2,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[atom_length,2]), call_c('Pl_Atom_Length_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:atom_concat/3,51,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[atom_concat,3]), call_c('Pl_Atom_Concat_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$atom_concat_alt'/0,55,static,private,monofile,built_in,[ call_c('Pl_Atom_Concat_Alt_0',[boolean],[]), proceed]). predicate(system:sub_atom/5,60,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sub_atom,5]), call_c('Pl_Sub_Atom_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:'$sub_atom_alt'/0,65,static,private,monofile,built_in,[ call_c('Pl_Sub_Atom_Alt_0',[boolean],[]), proceed]). predicate(system:atom_chars/2,71,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[atom_chars,2]), call_c('Pl_Atom_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:atom_codes/2,78,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[atom_codes,2]), call_c('Pl_Atom_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:number_atom/2,85,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[number_atom,2]), call_c('Pl_Number_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:number_chars/2,92,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[number_chars,2]), call_c('Pl_Number_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:number_codes/2,99,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[number_codes,2]), call_c('Pl_Number_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:char_code/2,106,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[char_code,2]), call_c('Pl_Char_Code_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:name/2,113,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[name,2]), call_c('Pl_Name_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:lower_upper/2,120,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[lower_upper,2]), call_c('Pl_Lower_Upper_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:current_atom/1,127,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_atom,1]), execute('$current_atom'/1)]). predicate(system:'$current_atom'/1,132,static,private,monofile,built_in,[ put_integer(1,1), call_c('Pl_Current_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_atom_any'/1,135,static,private,monofile,built_in,[ put_integer(0,1), call_c('Pl_Current_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_atom_alt'/0,139,static,private,monofile,built_in,[ call_c('Pl_Current_Atom_Alt_0',[boolean],[]), proceed]). predicate(system:atom_property/2,146,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[atom_property,2]), put_value(y(0),0), call('$current_atom'/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$atom_property1'/2)]). predicate(system:'$atom_property_any'/2,151,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), call('$current_atom_any'/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$atom_property1'/2)]). predicate(system:'$atom_property1'/2,158,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(1),0), call('$check_atom_prop'/1), cut(y(2)), put_value(y(0),0), put_variable(x(2),1), put_variable(x(3),7), put_variable(x(4),8), put_variable(x(5),9), put_variable(x(6),10), call_c('Pl_Atom_Property_6',[],[x(0),x(1),x(7),x(8),x(9),x(10)]), put_value(y(1),0), put_value(y(0),1), deallocate, execute('$atom_property2'/7)]). predicate(system:'$check_atom_prop'/1,165,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), retry_me_else(18), switch_on_term(4,2,fail,fail,3), label(2), switch_on_atom([(prefix_op,9),(infix_op,11),(postfix_op,13),(needs_quotes,15),(needs_scan,17)]), label(3), switch_on_structure([(length/1,5),(hash/1,7)]), label(4), try_me_else(6), label(5), get_structure(length/1,0), unify_void(1), proceed, label(6), retry_me_else(8), label(7), get_structure(hash/1,0), unify_void(1), proceed, label(8), retry_me_else(10), label(9), get_atom(prefix_op,0), proceed, label(10), retry_me_else(12), label(11), get_atom(infix_op,0), proceed, label(12), retry_me_else(14), label(13), get_atom(postfix_op,0), proceed, label(14), retry_me_else(16), label(15), get_atom(needs_quotes,0), proceed, label(16), trust_me_else_fail, label(17), get_atom(needs_scan,0), proceed, label(18), trust_me_else_fail, put_value(x(0),1), put_atom(atom_property,0), execute('$pl_err_domain'/2)]). predicate(system:'$atom_property2'/7,188,static,private,monofile,built_in,[ switch_on_term(3,1,fail,fail,2), label(1), switch_on_atom([(prefix_op,8),(infix_op,10),(postfix_op,12),(needs_quotes,14),(needs_scan,16)]), label(2), switch_on_structure([(length/1,4),(hash/1,6)]), label(3), try_me_else(5), label(4), get_structure(length/1,0), unify_variable(x(0)), call_c('Pl_Atom_Length_2',[boolean],[x(1),x(0)]), proceed, label(5), retry_me_else(7), label(6), get_structure(hash/1,0), unify_variable(x(0)), call_c('Pl_Term_Hash_2',[boolean],[x(1),x(0)]), proceed, label(7), retry_me_else(9), label(8), get_atom(prefix_op,0), get_integer(1,2), proceed, label(9), retry_me_else(11), label(10), get_atom(infix_op,0), get_integer(1,3), proceed, label(11), retry_me_else(13), label(12), get_atom(postfix_op,0), get_integer(1,4), proceed, label(13), retry_me_else(15), label(14), get_atom(needs_quotes,0), get_integer(1,5), proceed, label(15), trust_me_else_fail, label(16), get_atom(needs_scan,0), get_integer(1,6), proceed]). predicate(system:new_atom/1,207,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[new_atom,1]), put_atom(atom_,1), call_c('Pl_New_Atom_2',[boolean],[x(1),x(0)]), proceed]). predicate(system:new_atom/2,211,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[new_atom,2]), call_c('Pl_New_Atom_2',[boolean],[x(0),x(1)]), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/parse_supp.h���������������������������������������������������������������0000644�0001750�0001750�00000010211�13021324543�015624� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : parse_supp.h * * Descr.: parser support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define PARSE_END_OF_TERM_DOT 0 #define PARSE_END_OF_TERM_EOF 1 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct /* Parsed variable information */ { /* ------------------------------ */ char name[MAX_VAR_NAME_LENGTH]; /* variable name */ WamWord word; /* associated WAM word */ Bool named; /* has it a name ? */ int nb_of_uses; /* occurrence counter */ } InfVar; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef PARSE_SUPP_FILE InfVar pl_parse_dico_var[MAX_VAR_IN_TERM]; int pl_parse_nb_var; #else extern InfVar pl_parse_dico_var[]; extern int pl_parse_nb_var; #endif /* defined as this to avoid to force the */ /* inclusion of parse_supp.o if not needed */ /* (stream_supp.c uses pl_last_read_line/col) */ int pl_last_read_line; int pl_last_read_col; /*---------------------------------* * Function Prototypes * *---------------------------------*/ WamWord Pl_Read_Term(StmInf *pstm, int parse_end_of_term); WamWord Pl_Read_Atom(StmInf *pstm); WamWord Pl_Read_Integer(StmInf *pstm); WamWord Pl_Read_Number(StmInf *pstm); WamWord Pl_Read_Token(StmInf *pstm); ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/src_rdr.pl�����������������������������������������������������������������0000644�0001750�0001750�00000037247�13021324543�015307� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : src_rdr.pl * * Descr.: Prolog source file reader * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_src_rdr'. /* API setof(Y:X,(predicate_property(X, prolog_file(F)), decompose_file_name(F, _, src_rdr, '.pl'), predicate_property(X, prolog_line(Y))), L), member(_:A, L), functor(A,Func,Arity), write(Func/Arity), nl, fail. sr_open/3 sr_change_options/2 sr_close/1 sr_read_term/4 sr_current_descriptor/1 sr_get_stream/2 sr_get_module/3 sr_get_file_name/2 sr_get_position/3 sr_get_include_list/2 sr_get_include_stream_list/2 sr_get_size_counters/3 sr_get_error_counters/3 sr_set_error_counters/3 sr_write_message/4 sr_write_message/6 sr_write_message/8 sr_write_error/2 sr_write_error/4 sr_write_error/6 sr_error_from_exception/2 */ sr_open(FileOrStream, D, Options) :- set_bip_name(sr_open, 3), '$set_sr_defaults', '$get_sr_options'(Options, OutSorA), ( var(D) -> true ; '$pl_err_uninstantiation'(D) ), '$call_c'('Pl_SR_Init_Open_2'(D, OutSorA)), ( nonvar(FileOrStream), FileOrStream = '$stream'(_) -> '$call_c'('Pl_SR_Open_File_2'(FileOrStream, true)) ; '$sr_open_new_prolog_file'(FileOrStream) ). % option mask in sys_var[0]: % % include in b1/b0 treat/pass % op in b3/b2 0 / 0 = kill % set_prolog_flag in b5/b4 code: 0 / 1 = ignore % char_conversion in b7/b6 1 / 0 = hide % module in b9/b8 1 / 1 = reflect % % restart in b16 (0/1) % reflect_eof in b17 (0/1) % undo_directives in b18 (0/1) % write_error in b19 (0/1) % % in sys_var[1]: is output stream specified ? '$set_sr_defaults' :- '$sys_var_write'(0, 0b1111111110), % default mask '$sys_var_set_bit'(0, 19), '$sys_var_write'(1, 0). '$get_sr_options'(Options, OutSorA) :- '$check_list'(Options), g_assign('$sr_output_stream', 0), '$get_sr_options1'(Options), g_read('$sr_output_stream', OutSorA). '$get_sr_options1'([]). '$get_sr_options1'([X|Options]) :- '$get_sr_options2'(X), !, '$get_sr_options1'(Options). '$get_sr_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_sr_options2'(T) :- functor(T, F, 1), arg(1, T, A), '$check_nonvar'(A), '$sr_treat_pass_no'(F, _, SubMaskPos), BitPass is SubMaskPos * 2, BitTreat is BitPass + 1, set_bip_name(sr_open, 3), % due to the use of is/2 '$sr_set_treat_pass_bits'(A, BitPass, BitTreat). '$get_sr_options2'(restart(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 16) ; X = true, '$sys_var_set_bit'(0, 16) ). '$get_sr_options2'(reflect_eof(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 17) ; X = true, '$sys_var_set_bit'(0, 17) ). '$get_sr_options2'(undo_directives(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 18) ; X = true, '$sys_var_set_bit'(0, 18) ). '$get_sr_options2'(write_error(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 19) ; X = true, '$sys_var_set_bit'(0, 19) ). '$get_sr_options2'(output_stream(SorA)) :- '$check_nonvar'(SorA), g_link('$sr_output_stream', SorA), '$sys_var_write'(1, 1). '$get_sr_options2'(X) :- '$pl_err_domain'(sr_option, X). % '$sr_treat_pass_no'(Name, Arity, SubMaskPos) '$sr_treat_pass_no'(include, 1, 0). '$sr_treat_pass_no'(op, 3, 1). '$sr_treat_pass_no'(set_prolog_flag, 2, 2). '$sr_treat_pass_no'(char_conversion, 2, 3). '$sr_treat_pass_no'(module, 1, 4). '$sr_treat_pass_no'(end_module, 1, 4). '$sr_treat_pass_no'(body, 1, 4). '$sr_treat_pass_no'(end_body, 1, 4). '$sr_set_treat_pass_bits'(kill, BitPass, BitTreat) :- '$sys_var_reset_bit'(0, BitPass), '$sys_var_reset_bit'(0, BitTreat). '$sr_set_treat_pass_bits'(ignore, BitPass, BitTreat) :- '$sys_var_set_bit'(0, BitPass), '$sys_var_reset_bit'(0, BitTreat). '$sr_set_treat_pass_bits'(hide, BitPass, BitTreat) :- '$sys_var_reset_bit'(0, BitPass), '$sys_var_set_bit'(0, BitTreat). '$sr_set_treat_pass_bits'(reflect, BitPass, BitTreat) :- '$sys_var_set_bit'(0, BitPass), '$sys_var_set_bit'(0, BitTreat). '$sr_open_new_prolog_file'(File) :- '$call_c'('Pl_Prolog_File_Name_2'(File, File1)), '$call_c'('Pl_SR_Open_File_2'(File1, false)). /* ( '$call_c_test'('Pl_File_Permission_2'(File, [read])) -> File1 = File ; '$call_c'('Pl_Prolog_File_Name_2'(File, File1)) ), */ sr_change_options(D, Options) :- set_bip_name(sr_change_options, 2), '$call_c'('Pl_SR_Check_Descriptor_1'(D)), % also init sys_var[0] '$get_sr_options1'(Options), '$call_c'('Pl_SR_Change_Options_0'). sr_close(D) :- set_bip_name(sr_close, 1), '$call_c'('Pl_SR_Close_1'(D)). sr_new_pass(D) :- set_bip_name(sr_new_pass, 1), ( '$call_c_test'('Pl_SR_New_Pass_1'(D)) -> true ; '$pl_err_permission'(new_pass, one_pass_reader, D) ). sr_read_term(D, Term, Options, SRError) :- '$call_c'('Pl_SR_Check_Descriptor_1'(D)), repeat, '$call_c'('Pl_SR_Get_Stm_For_Read_Term_1'(Stm)), Stream = '$stream'(Stm), set_bip_name(sr_read_term, 3), '$catch'('$read_term'(Stream, Term, Options), Excep, true, system, sr_read_term, 3), '$call_c'('Pl_SR_Update_Position_0'), ( var(Excep) -> '$sr_treat_term'(Term, SRError) ; Term = '$sr_read_term_error', '$sr_error_from_exception'(Excep, SRError) ), ( SRError = sr_error(_, _), '$call_c_test'('Pl_SR_Is_Bit_Set_1'(19)) -> sr_write_error(D, SRError) ; true ), !. % cut to remove repeat choice-point %% '$sr_treat_term'(Term, SRError) handles a read term %% It can fail to enforce backtracking and next term reading. %% Warning: Term can be a variable - should not be altered. '$sr_treat_term'(Term, SRError) :- Term == end_of_file, !, % cut to backtrack to repeat '$call_c_test'('Pl_SR_EOF_Reached_1'(Err)), % this one can fail ( var(Err) -> SRError = sr_ok ; SRError = sr_error(warning, Err)). '$sr_treat_term'(Term, SRError) :- nonvar(Term), Term = (:- Directive), nonvar(Directive), functor(Directive, F, A), '$sr_treat_pass_no'(F, A, SubMaskPos), !, % cut to backtrack to repeat BitPass is SubMaskPos * 2, BitTreat is BitPass + 1, ( '$call_c_test'('Pl_SR_Is_Bit_Set_1'(BitTreat)) -> '$catch'('$sr_exec_directive'(Directive, SRError), Excep, '$sr_error_from_exception'(Excep, SRError), system, any, 0) ; true), ( var(Excep) -> '$call_c_test'('Pl_SR_Is_Bit_Set_1'(BitPass)) % can fail ; true). '$sr_treat_term'(_, sr_ok). '$sr_exec_directive'(Directive, SRError) :- '$sr_directive1'(Directive, SRError), !. '$sr_exec_directive'(_, SRError) :- SRError = sr_error(warning, 'directive failed'). '$sr_directive1'(include(File), sr_ok) :- '$sr_open_new_prolog_file'(File). '$sr_directive1'(op(Prec, Specif, Oper), sr_ok) :- ( nonvar(Specif), nonvar(Oper), '$sr_op_type'(Specif, OpType), current_op(OldPrec, OldSpecif, Oper), '$sr_op_type'(OldSpecif, OpType) -> true ; OldPrec = 0, OldSpecif = Specif ), '$call_c'('Pl_SR_Add_Directive_7'(0, Prec, Specif, Oper, OldPrec, OldSpecif, Oper)). '$sr_directive1'(set_prolog_flag(Flag, Value), sr_ok) :- ( nonvar(Flag), current_prolog_flag(Flag, OldValue) -> true ; true ), '$call_c'('Pl_SR_Add_Directive_7'(1, Flag, Value, 0, Flag, OldValue, 0)). '$sr_directive1'(char_conversion(InChar, OutChar), sr_ok) :- ( nonvar(InChar), current_char_conversion(InChar, OldOutChar) -> true ; OldOutChar = InChar ), '$call_c'('Pl_SR_Add_Directive_7'(2, InChar, OutChar, 0, InChar, OldOutChar, 0)). '$sr_directive1'(module(ModuleName), SRError) :- '$sr_start_module'(ModuleName, true, SRError). '$sr_directive1'(body(ModuleName), SRError) :- '$sr_start_module'(ModuleName, false, SRError). '$sr_directive1'(end_module(ModuleName), SRError) :- '$sr_stop_module'(ModuleName, true, SRError). '$sr_directive1'(end_body(ModuleName), SRError) :- '$sr_stop_module'(ModuleName, false, SRError). '$sr_op_type'(fx, prefix). '$sr_op_type'(fy, prefix). '$sr_op_type'(xfx, infix). '$sr_op_type'(yfx, infix). '$sr_op_type'(xfy, infix). '$sr_op_type'(xf, postfix). '$sr_op_type'(yf, postfix). '$sr_start_module'(ModuleName, ModulePart, SRError) :- '$call_c'('Pl_SR_Start_Module_3'(ModuleName, ModulePart, Err)), ( var(Err) -> SRError = sr_ok ; SRError = sr_error(warning, Err)). '$sr_stop_module'(ModuleName, ModulePart, SRError) :- '$call_c'('Pl_SR_Stop_Module_3'(ModuleName, ModulePart, Err)), ( var(Err) -> SRError = sr_ok ; SRError = sr_error(warning, Err)). sr_current_descriptor(D) :- set_bip_name(sr_current_descriptor, 1), '$call_c_test'('Pl_SR_Current_Descriptor_1'(D)). '$sr_current_descriptor_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_SR_Current_Descriptor_Alt_0'). sr_get_stream(D, Stream) :- set_bip_name(sr_get_stream, 2), '$check_stream_or_var'(Stream, Stm), '$call_c_test'('Pl_SR_Get_Stm_2'(D, Stm)). sr_get_module(D, ModuleName, ModulePart) :- set_bip_name(sr_get_module, 3), '$call_c_test'('Pl_SR_Get_Module_3'(D, ModuleName, ModulePart)). sr_get_file_name(D, File) :- set_bip_name(sr_get_file_name, 2), '$call_c_test'('Pl_SR_Get_File_Name_2'(D, File)). sr_get_position(D, L1, L2) :- set_bip_name(sr_get_position, 3), '$call_c_test'('Pl_SR_Get_Position_3'(D, L1, L2)). sr_get_include_list(D, IncList) :- set_bip_name(sr_get_include_list, 2), '$call_c_test'('Pl_SR_Get_Include_List_2'(D, IncList)). sr_get_include_stream_list(D, IncStreamList) :- set_bip_name(sr_get_include_stream_list, 2), '$call_c_test'('Pl_SR_Get_Include_Stream_List_2'(D, IncStreamList)). sr_get_size_counters(D, Chars, Lines) :- set_bip_name(sr_get_size_counters, 3), '$call_c_test'('Pl_SR_Get_Size_Counters_3'(D, Chars, Lines)). sr_get_error_counters(D, Errors, Warnings) :- set_bip_name(sr_get_error_counters, 3), '$call_c_test'('Pl_SR_Get_Error_Counters_3'(D, Errors, Warnings)). sr_set_error_counters(D, Errors, Warnings) :- set_bip_name(sr_set_error_counters, 3), '$call_c'('Pl_SR_Set_Error_Counters_3'(D, Errors, Warnings)). sr_write_message(D, Type, Format, Args) :- set_bip_name(sr_write_message, 4), '$call_c'('Pl_SR_Write_Message_4'(D, Type, Format, Args)). sr_write_message(D, L1, L2C, Type, Format, Args) :- set_bip_name(sr_write_message, 6), '$call_c'('Pl_SR_Write_Message_6'(D, L1, L2C, Type, Format, Args)). sr_write_message(D, IncList, File, L1, L2C, Type, Format, Args) :- set_bip_name(sr_write_message, 8), '$call_c'('Pl_SR_Write_Message_8'(D, IncList, File, L1, L2C, Type, Format, Args)). sr_write_error(D, SRError) :- set_bip_name(sr_write_error, 2), '$sr_get_format_args_error'(SRError, L1, L2C, Type, Format, Args), ( var(L1), '$call_c'('Pl_SR_Write_Message_4'(D, Type, Format, Args)) ; '$call_c'('Pl_SR_Write_Message_6'(D, L1, L2C, Type, Format, Args)) ), !. sr_write_error(_, _). % succes - nothing written for sr_ok sr_write_error(D, L1, L2C, SRError) :- set_bip_name(sr_write_error, 4), '$sr_get_format_args_error'(SRError, EL1, EL2C, Type, Format, Args), ( L1 = EL1, L2C = EL2C ; true ), '$call_c'('Pl_SR_Write_Message_6'(D, EL1, EL2C, Type, Format, Args)), !. sr_write_error(_, _, _, _). % succes - nothing written for sr_ok sr_write_error(D, IncList, File, L1, L2C, SRError) :- set_bip_name(sr_write_error, 6), '$sr_get_format_args_error'(SRError, EL1, EL2C, Type, Format, Args), ( L1 = EL1, L2C = EL2C ; true ), '$call_c'('Pl_SR_Write_Message_8'(D, IncList, File, EL1, EL2C, Type, Format, Args)), !. sr_write_error(_, _, _, _, _, _). % succes - nothing written for sr_ok '$sr_get_format_args_error'(SRError, _, _, _, _, _) :- var(SRError), '$pl_err_instantiation'. '$sr_get_format_args_error'(SRError, L1, L2C, Type, Format, Args) :- SRError = sr_error(Type, Error), % fail for sr_ok '$sr_simpl_error'(Error, L1, L2C, Format, Args). '$sr_simpl_error'(syntax(Line, Char, Error), Line, L2C, Format, Args) :- !, L2C is -Char, Format = '~a~n', Args = [Error]. '$sr_simpl_error'(existence_error(source_sink, F), _, _, Format, Args) :- !, Format = 'cannot open file ~a - does not exist~n', Args = [F]. '$sr_simpl_error'(permission_error(open, source_sink, F), _, _, Format, Args) :- !, Format = 'cannot open file ~a - permission error~n', Args = [F]. '$sr_simpl_error'(Error, _, _, Format, Args) :- Format = '~w~n', Args = [Error]. sr_error_from_exception(Excep, SRError) :- set_bip_name(sr_error_from_exception, 2), ( var(Excep) -> '$pl_err_instantiation' ; true ), '$sr_error_from_exception'(Excep, SRError). '$sr_error_from_exception'(error(syntax_error(_), _), SRError) :- !, syntax_error_info(_, Line, Char, Error), SRError = sr_error(error, syntax(Line, Char, Error)). '$sr_error_from_exception'(error(Excep, _), sr_error(error, Excep)) :- !. '$sr_error_from_exception'(Excep, sr_error(exception, Excep)). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/bc_supp.h������������������������������������������������������������������0000644�0001750�0001750�00000007243�13021324543�015111� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : bc_supp.h * * Descr.: byte-Code support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef BC_SUPP_FILE int pl_byte_len; #else extern int pl_byte_len; #endif /* defined as this to avoid to force the */ /* inclusion of bc_supp.o if not needed */ /* (dynam_supp.c uses pl_byte_code) */ unsigned *pl_byte_code; /*---------------------------------* * Function Prototypes * *---------------------------------*/ WamCont Pl_BC_Call_Initial(int module, int func, int arity, WamWord *arg_adr, WamWord goal_word, int caller_func, int caller_arity, Bool debug_call); void Pl_BC_Start_Emit_0(void); void Pl_BC_Stop_Emit_0(void); void Pl_BC_Emit_Inst_1(WamWord inst_word); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/foreign.wam����������������������������������������������������������������0000644�0001750�0001750�00000000523�13021356407�015442� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : foreign.pl file_name('/home/diaz/GP/src/BipsPl/foreign.pl'). predicate(system:'$force_foreign_link'/0,45,static,private,monofile,built_in,[ proceed]). predicate(system:'$pl_query_recover_alt'/0,50,static,private,monofile,built_in,[ call_c('Pl_Query_Recover_Alt_0',[],[]), fail]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/unify.pl�������������������������������������������������������������������0000644�0001750�0001750�00000005574�13021324543�015001� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : unify.pl * * Descr.: unification management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_unify'. X = X. unify_with_occurs_check(X, Y) :- '$call_c'('Pl_Unify_Occurs_Check'(X, Y), [boolean, fast_call]). X \= Y :- \+ X = Y. ������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/os_interf.wam��������������������������������������������������������������0000644�0001750�0001750�00000034502�13021356407�016005� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : os_interf.pl file_name('/home/diaz/GP/src/BipsPl/os_interf.pl'). predicate(system:'$use_os_interf'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:make_directory/1,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[make_directory,1]), call_c('Pl_Make_Directory_1',[boolean],[x(0)]), proceed]). predicate(system:delete_directory/1,51,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[delete_directory,2]), call_c('Pl_Delete_Directory_1',[boolean],[x(0)]), proceed]). predicate(system:working_directory/1,58,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[working_directory,1]), call_c('Pl_Working_Directory_1',[boolean],[x(0)]), proceed]). predicate(system:change_directory/1,65,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[change_directory,1]), call_c('Pl_Change_Directory_1',[boolean],[x(0)]), proceed]). predicate(system:directory_files/2,71,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[directory_files,2]), call_c('Pl_Directory_Files_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:rename_file/2,78,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[rename_file,2]), call_c('Pl_Rename_File_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:unlink/1,85,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[unlink,2]), call_c('Pl_Unlink_1',[],[x(0)]), proceed]). predicate(system:delete_file/1,92,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[delete_file,2]), call_c('Pl_Delete_File_1',[boolean],[x(0)]), proceed]). predicate(system:file_exists/1,99,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[file_exists,1]), call_c('Pl_File_Exists_1',[boolean],[x(0)]), proceed]). predicate(system:file_permission/2,104,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[file_permission,2]), call_c('Pl_File_Permission_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:file_property/2,111,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[file_property,2]), put_value(y(1),0), call('$check_file_prop'/1), cut(y(2)), put_value(y(1),0), put_value(y(0),1), deallocate, execute('$file_prop'/2)]). predicate(system:'$check_file_prop'/1,119,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), retry_me_else(19), switch_on_term(3,fail,fail,fail,2), label(2), switch_on_structure([(absolute_file_name/1,4),(real_file_name/1,6),(type/1,8),(size/1,10),(permission/1,12),(creation/1,14),(last_access/1,16),(last_modification/1,18)]), label(3), try_me_else(5), label(4), get_structure(absolute_file_name/1,0), unify_void(1), proceed, label(5), retry_me_else(7), label(6), get_structure(real_file_name/1,0), unify_void(1), proceed, label(7), retry_me_else(9), label(8), get_structure(type/1,0), unify_void(1), proceed, label(9), retry_me_else(11), label(10), get_structure(size/1,0), unify_void(1), proceed, label(11), retry_me_else(13), label(12), get_structure(permission/1,0), unify_void(1), proceed, label(13), retry_me_else(15), label(14), get_structure(creation/1,0), unify_void(1), proceed, label(15), retry_me_else(17), label(16), get_structure(last_access/1,0), unify_void(1), proceed, label(17), trust_me_else_fail, label(18), get_structure(last_modification/1,0), unify_void(1), proceed, label(19), trust_me_else_fail, put_value(x(0),1), put_atom(os_file_property,0), execute('$pl_err_domain'/2)]). predicate(system:'$file_prop'/2,144,static,private,monofile,built_in,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(absolute_file_name/1,3),(real_file_name/1,5),(type/1,7),(size/1,9),(permission/1,11),(creation/1,13),(last_access/1,15),(last_modification/1,17)]), label(2), try_me_else(4), label(3), get_structure(absolute_file_name/1,0), unify_variable(x(0)), call_c('Pl_File_Prop_Absolute_File_Name_2',[boolean],[x(0),x(1)]), proceed, label(4), retry_me_else(6), label(5), get_structure(real_file_name/1,0), unify_variable(x(0)), call_c('Pl_File_Prop_Real_File_Name_2',[boolean],[x(0),x(1)]), proceed, label(6), retry_me_else(8), label(7), get_structure(type/1,0), unify_variable(x(0)), call_c('Pl_File_Prop_Type_2',[boolean],[x(0),x(1)]), proceed, label(8), retry_me_else(10), label(9), get_structure(size/1,0), unify_variable(x(0)), call_c('Pl_File_Prop_Size_2',[boolean],[x(0),x(1)]), proceed, label(10), retry_me_else(12), label(11), get_structure(permission/1,0), unify_variable(x(0)), call_c('Pl_Check_Prop_Perm_And_File_2',[boolean],[x(0),x(1)]), execute('$file_prop_perm'/2), label(12), retry_me_else(14), label(13), allocate(2), get_structure(creation/1,0), unify_variable(y(0)), get_variable(y(1),1), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_File_Prop_Date_2',[boolean],[x(0),x(1)]), proceed, label(14), retry_me_else(16), label(15), allocate(2), get_structure(last_access/1,0), unify_variable(y(0)), get_variable(y(1),1), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_File_Prop_Date_2',[boolean],[x(0),x(1)]), proceed, label(16), trust_me_else_fail, label(17), allocate(2), get_structure(last_modification/1,0), unify_variable(y(0)), get_variable(y(1),1), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_File_Prop_Date_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$file_prop_perm'/2,173,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(read,3),(write,5),(execute,7),(search,9)]), label(2), try_me_else(4), label(3), get_atom(read,0), put_value(x(1),0), put_atom(read,1), execute(file_permission/2), label(4), retry_me_else(6), label(5), get_atom(write,0), put_value(x(1),0), put_atom(write,1), execute(file_permission/2), label(6), retry_me_else(8), label(7), get_atom(execute,0), put_value(x(1),0), put_atom(execute,1), execute(file_permission/2), label(8), trust_me_else_fail, label(9), get_atom(search,0), put_value(x(1),0), put_atom(search,1), execute(file_permission/2)]). predicate(system:temporary_name/2,188,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[temporary_name,2]), call_c('Pl_Temporary_Name_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:temporary_file/3,195,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[temporary_file,3]), call_c('Pl_Temporary_File_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:date_time/1,202,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[date_time,1]), call_c('Pl_Date_Time_1',[boolean],[x(0)]), proceed]). predicate(system:host_name/1,209,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[host_name,1]), call_c('Pl_Host_Name_1',[boolean],[x(0)]), proceed]). predicate(system:os_version/1,216,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[os_version,1]), call_c('Pl_Os_Version_1',[boolean],[x(0)]), proceed]). predicate(system:architecture/1,223,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[architecture,1]), call_c('Pl_Architecture_1',[boolean],[x(0)]), proceed]). predicate(system:shell/0,230,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[shell,0]), put_atom('',0), put_integer(0,1), call_c('Pl_Shell_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:shell/1,234,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[shell,1]), put_integer(0,1), call_c('Pl_Shell_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:shell/2,238,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[shell,2]), call_c('Pl_Shell_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:system/1,245,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[system,1]), put_integer(0,1), call_c('Pl_System_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:system/2,249,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[system,2]), call_c('Pl_System_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:spawn/2,256,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[spawn,2]), put_integer(0,2), call_c('Pl_Spawn_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:spawn/3,260,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[spawn,3]), call_c('Pl_Spawn_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:sleep/1,267,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sleep,1]), call_c('Pl_Sleep_1',[],[x(0)]), proceed]). predicate(system:popen/3,274,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[popen,3]), put_value(x(2),0), put_variable(y(2),1), call('$get_open_stm'/2), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(2),2), deallocate, call_c('Pl_Popen_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:exec/5,286,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[exec,5]), put_value(y(4),0), call('$exec/5_$aux1'/1), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_integer(0,0), put_integer(0,1), call('$sys_var_set_bit'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute('$exec'/5)]). predicate(system:'$exec/5_$aux1'/1,286,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_uninstantiation'/1), label(1), trust_me_else_fail, proceed]). predicate(system:exec/4,298,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[exec,4]), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_integer(0,4), deallocate, execute('$exec'/5)]). predicate(system:'$exec'/5,306,static,private,monofile,built_in,[ allocate(7), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), put_value(x(1),0), put_variable(y(4),1), call('$get_open_stm'/2), put_value(y(1),0), put_variable(y(5),1), call('$get_open_stm'/2), put_value(y(2),0), put_variable(y(6),1), call('$get_open_stm'/2), put_value(y(0),0), put_unsafe_value(y(4),1), put_unsafe_value(y(5),2), put_unsafe_value(y(6),3), put_value(y(3),4), deallocate, call_c('Pl_Exec_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:create_pipe/2,316,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[create_pipe,2]), put_variable(y(1),1), call('$get_open_stm'/2), put_value(y(0),0), put_variable(y(2),1), call('$get_open_stm'/2), put_unsafe_value(y(1),0), put_unsafe_value(y(2),1), deallocate, call_c('Pl_Create_Pipe_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:fork_prolog/1,325,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[fork_prolog,1]), put_value(y(0),0), call('$fork_prolog/1_$aux1'/1), put_value(y(0),0), deallocate, call_c('Pl_Fork_Prolog_1',[boolean],[x(0)]), proceed]). predicate(system:'$fork_prolog/1_$aux1'/1,325,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_uninstantiation'/1), label(1), trust_me_else_fail, proceed]). predicate(system:select/5,336,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[select,5]), call_c('Pl_Select_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:prolog_pid/1,343,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[prolog_pid,1]), call_c('Pl_Prolog_Pid_1',[boolean],[x(0)]), proceed]). predicate(system:send_signal/2,350,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[send_signal,2]), call_c('Pl_Send_Signal_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:wait/2,357,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[wait,2]), call_c('Pl_Wait_2',[boolean],[x(0),x(1)]), proceed]). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/char_io.pl�����������������������������������������������������������������0000644�0001750�0001750�00000012731�13021324543�015244� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : char_io.pl * * Descr.: character input-output management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_char_io'. get_key(Code) :- set_bip_name(get_key, 1), '$call_c_test'('Pl_Get_Key_1'(Code)). get_key(SorA, Code) :- set_bip_name(get_key, 2), '$call_c_test'('Pl_Get_Key_2'(SorA, Code)). get_key_no_echo(Code) :- set_bip_name(get_key_no_echo, 1), '$call_c_test'('Pl_Get_Key_No_Echo_1'(Code)). get_key_no_echo(SorA, Code) :- set_bip_name(get_key_no_echo, 2), '$call_c_test'('Pl_Get_Key_No_Echo_2'(SorA, Code)). % get predicates get_char(Char) :- set_bip_name(get_char, 1), '$call_c_test'('Pl_Get_Char_1'(Char)). get_char(SorA, Char) :- set_bip_name(get_char, 2), '$call_c_test'('Pl_Get_Char_2'(SorA, Char)). get_code(Code) :- set_bip_name(get_code, 1), '$call_c_test'('Pl_Get_Code_1'(Code)). get_code(SorA, Code) :- set_bip_name(get_code, 2), '$call_c_test'('Pl_Get_Code_2'(SorA, Code)). get_byte(Byte) :- set_bip_name(get_byte, 1), '$call_c_test'('Pl_Get_Byte_1'(Byte)). get_byte(SorA, Byte) :- set_bip_name(get_byte, 2), '$call_c_test'('Pl_Get_Byte_2'(SorA, Byte)). % unget predicates unget_char(Char) :- set_bip_name(unget_char, 1), '$call_c'('Pl_Unget_Char_1'(Char)). unget_char(SorA, Char) :- set_bip_name(unget_char, 2), '$call_c'('Pl_Unget_Char_2'(SorA, Char)). unget_code(Code) :- set_bip_name(unget_code, 1), '$call_c'('Pl_Unget_Code_1'(Code)). unget_code(SorA, Code) :- set_bip_name(unget_code, 2), '$call_c'('Pl_Unget_Code_2'(SorA, Code)). unget_byte(Byte) :- set_bip_name(unget_byte, 1), '$call_c'('Pl_Unget_Byte_1'(Byte)). unget_byte(SorA, Byte) :- set_bip_name(unget_byte, 2), '$call_c'('Pl_Unget_Byte_2'(SorA, Byte)). % peek predicates peek_char(Char) :- set_bip_name(peek_char, 1), '$call_c_test'('Pl_Peek_Char_1'(Char)). peek_char(SorA, Char) :- set_bip_name(peek_char, 2), '$call_c_test'('Pl_Peek_Char_2'(SorA, Char)). peek_code(Code) :- set_bip_name(peek_code, 1), '$call_c_test'('Pl_Peek_Code_1'(Code)). peek_code(SorA, Code) :- set_bip_name(peek_code, 2), '$call_c_test'('Pl_Peek_Code_2'(SorA, Code)). peek_byte(Byte) :- set_bip_name(peek_byte, 1), '$call_c_test'('Pl_Peek_Byte_1'(Byte)). peek_byte(SorA, Byte) :- set_bip_name(peek_byte, 2), '$call_c_test'('Pl_Peek_Byte_2'(SorA, Byte)). % put predicates put_char(Char) :- set_bip_name(put_char, 1), '$call_c'('Pl_Put_Char_1'(Char)). put_char(SorA, Char) :- set_bip_name(put_char, 2), '$call_c'('Pl_Put_Char_2'(SorA, Char)). put_code(Code) :- set_bip_name(put_code, 1), '$call_c'('Pl_Put_Code_1'(Code)). put_code(SorA, Code) :- set_bip_name(put_code, 2), '$call_c'('Pl_Put_Code_2'(SorA, Code)). put_byte(Byte) :- set_bip_name(put_byte, 1), '$call_c'('Pl_Put_Byte_1'(Byte)). put_byte(SorA, Byte) :- set_bip_name(put_byte, 2), '$call_c'('Pl_Put_Byte_2'(SorA, Byte)). ���������������������������������������gprolog-1.4.5/src/BipsPl/read.pl��������������������������������������������������������������������0000644�0001750�0001750�00000016252�13021324543�014555� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : read.pl * * Descr.: term input (read/1 and friends) management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_read'. /* warning: if you change this file check also definitions in const_io.pl */ read(Term) :- set_bip_name(read, 1), '$set_read_defaults', '$call_c_test'('Pl_Read_1'(Term)). read(SorA, Term) :- set_bip_name(read, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_2'(SorA, Term)). % option mask in sys_var[0]: % % b3 b2 b1 b0 % 0/1 0/1 0/1 0/1 % end_of_term singletons var_names vars % 0=dot 0=false 0=false 0=false % 1=eof 1=true 1=true 1=true % % syntax error action in sys_var[1]: % % -1=not specified % 0=error raise an error (iso) % 1=waning display a message and fail % 2=fail quietly fail read_term(Term, Options) :- set_bip_name(read_term, 2), '$set_read_defaults', '$get_read_options'(Options, Vars, VarNames, SinglNames), '$call_c_test'('Pl_Read_Term_4'(Term, Vars, VarNames, SinglNames)). read_term(SorA, Term, Options) :- set_bip_name(read_term, 3), '$read_term'(SorA, Term, Options). '$read_term'(SorA, Term, Options) :- '$set_read_defaults', '$get_read_options'(Options, Vars, VarNames, SinglNames), '$call_c_test'('Pl_Read_Term_5'(SorA, Term, Vars, VarNames, SinglNames)). '$set_read_defaults' :- %if modified, modified also const_io_c.c '$sys_var_write'(0, 0), % default mask '$sys_var_write'(1, -1). '$get_read_options'(Options, Vars, VarNames, SinglNames) :- '$check_list'(Options), g_assign('$read_variables', []), g_assign('$read_variable_names', []), g_assign('$read_singletons', []), '$get_read_options1'(Options), g_read('$read_variables', Vars), g_read('$read_variable_names', VarNames), g_read('$read_singletons', SinglNames). '$get_read_options1'([]). '$get_read_options1'([X|Options]) :- '$get_read_options2'(X), !, '$get_read_options1'(Options). '$get_read_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_read_options2'(variables(Vars)) :- list_or_partial_list(Vars), g_link('$read_variables', Vars), '$sys_var_set_bit'(0, 0). '$get_read_options2'(variable_names(VarNames)) :- list_or_partial_list(VarNames), g_link('$read_variable_names', VarNames), '$sys_var_set_bit'(0, 1). '$get_read_options2'(singletons(SinglNames)) :- list_or_partial_list(SinglNames), g_link('$read_singletons', SinglNames), '$sys_var_set_bit'(0, 2). '$get_read_options2'(syntax_error(X)) :- '$check_nonvar'(X), ( X = error, '$sys_var_write'(1, 0) % same order as in flag_supp.h ; X = warning, '$sys_var_write'(1, 1) ; X = fail, '$sys_var_write'(1, 2) ). '$get_read_options2'(end_of_term(X)) :- '$check_nonvar'(X), ( X = dot, '$sys_var_reset_bit'(0, 3) ; X = eof, '$sys_var_set_bit'(0, 3) ). '$get_read_options2'(X) :- '$pl_err_domain'(read_option, X). read_atom(Atom) :- set_bip_name(read_atom, 1), '$set_read_defaults', '$call_c_test'('Pl_Read_Atom_1'(Atom)). read_atom(SorA, Atom) :- set_bip_name(read_atom, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_Atom_2'(SorA, Atom)). read_integer(Integer) :- set_bip_name(read_integer, 1), '$set_read_defaults', '$call_c_test'('Pl_Read_Integer_1'(Integer)). read_integer(SorA, Integer) :- set_bip_name(read_integer, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_Integer_2'(SorA, Integer)). read_number(Number) :- set_bip_name(read_number, 1), '$set_read_defaults', '$call_c_test'('Pl_Read_Number_1'(Number)). read_number(SorA, Number) :- set_bip_name(read_number, 2), '$set_read_defaults', '$call_c_test'('Pl_Read_Number_2'(SorA, Number)). read_token(Token) :- set_bip_name(read_token, 1), '$call_c_test'('Pl_Read_Token_1'(Token)). read_token(SorA, Token) :- set_bip_name(read_token, 2), '$call_c_test'('Pl_Read_Token_2'(SorA, Token)). last_read_start_line_column(Line, Col) :- set_bip_name(last_read_start_line_column, 2), '$call_c_test'('Pl_Last_Read_Start_Line_Column_2'(Line, Col)). char_conversion(InChar, OutChar) :- set_bip_name(char_conversion, 2), '$call_c'('Pl_Char_Conversion_2'(InChar, OutChar)). current_char_conversion(InChar, OutChar) :- set_bip_name(current_char_conversion, 2), '$call_c_test'('Pl_Current_Char_Conversion_2'(InChar, OutChar)). '$current_char_conversion_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Char_Conversion_Alt_0'). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/scan_supp.c����������������������������������������������������������������0000644�0001750�0001750�00000056643�13021324543�015454� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : scan_supp.c * * Descr.: scanner support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <ctype.h> #include <stdarg.h> #define SCAN_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int c_orig, c; /* for read */ static int c_type; static char *err_msg; /* parser variables */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int Read_Next_Char(StmInf *pstm, Bool convert); static void Scan_Number(StmInf *pstm, Bool integer_only); static void Scan_Quoted(StmInf *pstm); static int Scan_Quoted_Char(StmInf *pstm, Bool convert, int c0, Bool no_escape); #define Unget_Last_Char Pl_Stream_Ungetc(c_orig, pstm) /*-------------------------------------------------------------------------* * PL_SCAN_PEEK_CHAR * * * *-------------------------------------------------------------------------*/ int Pl_Scan_Peek_Char(StmInf *pstm, Bool convert) { int c_look; c_look = Pl_Stream_Peekc(pstm); if (convert) c_look = Char_Conversion(c_look); return c_look; } /*-------------------------------------------------------------------------* * READ_NEXT_CHAR * * * *-------------------------------------------------------------------------*/ static int Read_Next_Char(StmInf *pstm, Bool convert) { c_orig = c = Pl_Stream_Getc(pstm); if (c == EOF) c_type = 0; else { if (convert) c = Char_Conversion(c); c_type = pl_char_type[c]; } return c; } /*-------------------------------------------------------------------------* * PL_SCAN_TOKEN * * * * Scan the next pl_token. The flag comma_is_punct specifies if ',' must be* * considered as a punctuation (e.g. separator of args of compound term or * * of a list) or as an atom. * * The scanner only consumes the needed characters of the pl_token, calling* * Unget_Last_Char if necessary (see Scan_Number). Thus after a pl_token * * has been read Pl_Stream_Peekc() will return the character directly * * following this pl_token. * *-------------------------------------------------------------------------*/ char * Pl_Scan_Token(StmInf *pstm, Bool comma_is_punct) { int c0; char *s; Bool layout_before = FALSE; err_msg = NULL; start_scan: for (;;) { Read_Next_Char(pstm, TRUE); if (c_type != LA) /* layout character */ break; layout_before = TRUE; } pl_token.quoted = FALSE; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; if (c == EOF) { pl_token.type = TOKEN_END_OF_FILE; return err_msg; } switch (c_type) { case SL: /* small letter */ case UL: /* underline */ case CL: /* capital letter */ pl_token.type = (c_type == SL) ? TOKEN_NAME : TOKEN_VARIABLE; s = pl_token.name; do { *s++ = c; Read_Next_Char(pstm, TRUE); } while (c_type & (UL | CL | SL | DI)); *s = '\0'; Unget_Last_Char; break; case DI: /* digit */ Scan_Number(pstm, FALSE); break; case QT: /* quote */ case DQ: /* double quote */ case BQ: /* back quote */ Scan_Quoted(pstm); break; case GR: /* graphic */ c0 = c; Read_Next_Char(pstm, TRUE); if (c0 == '.' && (c == EOF || (c_type & (LA | CM)))) { if (c_type != EOF) Unget_Last_Char; pl_token.type = TOKEN_FULL_STOP; break; } if (c0 == '/' && c == '*') /* comment */ { Read_Next_Char(pstm, TRUE); if (c != EOF) do { c0 = c; Read_Next_Char(pstm, TRUE); } while (c != EOF && (c0 != '*' || c != '/')); if (c == EOF) { pl_token.type = TOKEN_END_OF_FILE; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; err_msg = "*/ expected here for /*...*/ comment"; break; } layout_before = TRUE; goto start_scan; } pl_token.type = TOKEN_NAME; s = pl_token.name; *s++ = c0; while (c_type == GR) { *s++ = c; Read_Next_Char(pstm, TRUE); } *s = '\0'; Unget_Last_Char; break; case CM: /* comment character */ do Read_Next_Char(pstm, TRUE); while (c != '\n' && c != EOF); #if 0 // what says standard ? EOF allowed at end of %... comment ? if (c == EOF) { pl_token.type = TOKEN_END_OF_FILE; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; err_msg = "new-line expected here for %%... comment"; break; } #endif layout_before = TRUE; goto start_scan; case PC: /* punctuation character */ if (c == '(' && !layout_before) { pl_token.type = TOKEN_IMMEDIAT_OPEN; break; } pl_token.type = TOKEN_PUNCTUATION; pl_token.punct = c; #if 0 /* to return [] and {} as a token (else [ is a token and ] is another token) */ if (c == '[') { Read_Next_Char(pstm, TRUE); if (c == ']') { pl_token.type = TOKEN_NAME; strcpy(pl_token.name, "[]"); break; } Unget_Last_Char; } if (c == '{') { Read_Next_Char(pstm, TRUE); if (c == '}') { pl_token.type = TOKEN_NAME; strcpy(pl_token.name, "{}"); break; } Unget_Last_Char; } #endif break; case SC: /* solo character */ if (c == ',' && comma_is_punct) { pl_token.type = TOKEN_PUNCTUATION; pl_token.punct = c; break; } pl_token.type = TOKEN_NAME; pl_token.name[0] = c; pl_token.name[1] = '\0'; break; case EX: /* extended character */ pl_token.type = TOKEN_EXTENDED; pl_token.name[0] = c; pl_token.name[1] = '\0'; break; } return err_msg; } /*-------------------------------------------------------------------------* * SCAN_NUMBER * * * *-------------------------------------------------------------------------*/ static void Scan_Number(StmInf *pstm, Bool integer_only) { int lg; int radix, radix_c; char *p, *f; int c_orig0; /* at entry: c is a digit */ p = pl_token.name; do { *p++ = c; Read_Next_Char(pstm, TRUE); } while (c_type == DI); lg = p - pl_token.name; if (!integer_only && /* float if . and digit */ c == '.' && isdigit(Pl_Scan_Peek_Char(pstm, TRUE))) goto is_a_float; /* integer number */ pl_token.type = TOKEN_INTEGER; *p = '\0'; /* if case of an underflow/overflow strtol() returns LONG_MIN/LONG_MAX and * sets errno to ERANGE. We dont test it because LONG_MIN is < INT_LOWEST_VALUE * and LONG_MAX is > INT_GREATEST_VALUE. We will detect it at return from * this function. */ pl_token.int_num = Str_To_PlLong(pl_token.name, &p, 10); if (lg != 1 || pl_token.int_num != 0 || strchr("'box", c) == NULL) goto push_back; if (c == '\'') /* 0'<character> */ { c = Scan_Quoted_Char(pstm, TRUE, '\'', FALSE); if (c == -1) /* <character> is ' */ { /* STRICT ISO does not allow 0'' one should write 0''' or 0'\' */ if (Flag_Value(strict_iso)) { /* do not emit an error since 0'' is valid if '' is a postif/infix op * (this is the only case) - simply return the integer 0 */ #if 1 if (Check_Oper(pl_atom_void, INFIX) || Check_Oper(pl_atom_void, POSTFIX)) { Pl_Stream_Ungetc('\'', pstm); /* push back last ' */ Pl_Stream_Ungetc('\'', pstm); /* push back first ' */ return; } #endif pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos + 1; err_msg = "quote character expected here"; return; } else c = '\''; } else if (c == -2) /* \ newline */ { Unget_Last_Char; /* push back \n */ Pl_Stream_Ungetc('\\', pstm); /* push back \ */ Pl_Stream_Ungetc('\'', pstm); /* push back ' */ return; } else if (c < 0) /* \ newline EOF newline tab other error */ { Unget_Last_Char; pl_token.type = TOKEN_FULL_STOP; /* to stop immediately Pl_Recover_After_Error */ pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos + 1; err_msg = "character expected here"; return; } pl_token.int_num = c; return; } radix_c = c; radix = (c == 'b') ? (f = "01", 2) : (c == 'o') ? (f = "01234567", 8) : (f = "0123456789abcdefABCDEF", 16); p = pl_token.name; Read_Next_Char(pstm, TRUE); while (strchr(f, c) != NULL) { *p++ = c; Read_Next_Char(pstm, TRUE); } *p = '\0'; /* empty sequence after radix: maybe an operator beginnig with b or o or x: * op(9,yfx,bop) then 0bop 2 is 0 bop 2 */ if (p == pl_token.name) { Unget_Last_Char; /* push back last char */ Pl_Stream_Ungetc(radix_c, pstm); /* push back \ */ return; } pl_token.int_num = Str_To_PlLong(pl_token.name, &p, radix); goto push_back; is_a_float: /* float number */ pl_token.type = TOKEN_FLOAT; *p++ = '.'; Read_Next_Char(pstm, TRUE); while (c_type == DI) { *p++ = c; Read_Next_Char(pstm, TRUE); } if (c == 'e' || c == 'E') { c_orig0 = c_orig; Read_Next_Char(pstm, TRUE); if (!(c_type == DI || ((c == '+' || c == '-') && isdigit(Pl_Scan_Peek_Char(pstm, TRUE))))) { Unget_Last_Char; c_orig = c_orig0; goto end_float; } *p++ = 'e'; *p++ = c; Read_Next_Char(pstm, TRUE); while (c_type == DI) { *p++ = c; Read_Next_Char(pstm, TRUE); } } end_float: *p = '\0'; sscanf(pl_token.name, "%lf", &pl_token.float_num); push_back: Unget_Last_Char; } /*-------------------------------------------------------------------------* * SCAN_QUOTED * * * *-------------------------------------------------------------------------*/ static void Scan_Quoted(StmInf *pstm) { int c0; char *s; Bool convert = (c_orig != '\''); Bool no_escape; Bool error_found = FALSE; int i = 0; if (c_type == QT) { pl_token.type = TOKEN_NAME; pl_token.quoted = TRUE; i = 0; } else if (c_type == DQ) { pl_token.type = TOKEN_STRING; i = Flag_Value(double_quotes); } else { pl_token.type = TOKEN_BACK_QUOTED; i = Flag_Value(back_quotes); } s = pl_token.name; c0 = c; no_escape = i >> PF_QUOT_NO_ESCAPE_BIT; for (;;) { c = Scan_Quoted_Char(pstm, convert, c0, no_escape); if (c == -1) /* closing quote */ { if (error_found) break; *s = '\0'; return; } if (c == -2) /* \ followed by newline */ continue; if (c == -3 || c == -4) /* EOF newline */ { pl_token.type = TOKEN_FULL_STOP; /* to stop immediately Pl_Recover_After_Error */ *s = '\0'; return; } if (c == -5 || c == -6) /* tab or other error */ { error_found = TRUE; continue; /* continue to try to catch the closing quote */ } if (!error_found) *s++ = c; } /* error */ *s = '\0'; if (err_msg != NULL) /* this test should now always succeed */ return; /* thus this should never been used - to be checked */ Unget_Last_Char; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos + 1; switch (pl_token.type) { case TOKEN_NAME: err_msg = "quote character expected here"; break; case TOKEN_BACK_QUOTED: err_msg = "back quote character expected here"; break; case TOKEN_STRING: err_msg = "double quote character expected here"; break; default: /* to avoid compiler warning */ ; } } /*-------------------------------------------------------------------------* * SCAN_QUOTED_CHAR * * * *-------------------------------------------------------------------------*/ static int Scan_Quoted_Char(StmInf *pstm, Bool convert, int c0, Bool no_escape) { int radix; char *p, *f; int x, i; Read_Next_Char(pstm, convert); if (c == c0) { if (Pl_Scan_Peek_Char(pstm, convert) != c0) /* '' or "" or `` */ return -1; /* closing quote */ Read_Next_Char(pstm, convert); return c; } if (c == EOF) { if (err_msg == NULL) { Unget_Last_Char; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos + 1; err_msg = "unexpected end of file"; } return -3; /* -3 means EOF */ } if (c == '\n') { if (err_msg == NULL) { Unget_Last_Char; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos + 1; err_msg = "unexpected newline"; } return -4; /* -4 means newline */ } if (c == '\t') { if (err_msg == NULL) { Unget_Last_Char; pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos + 1; err_msg = "unexpected tab"; } return -5; /* -5 means tab */ } if (c != '\\' || no_escape) return c; /* \... escape sequences */ Read_Next_Char(pstm, convert); if (c == '\n') /* \ followed by newline */ return -2; /* -2 means \ newline */ if (strchr("\\'\"`", c)) /* \\ or \' or \" or \` */ return c; if ((p = (char *) strchr(pl_escape_symbol, c))) /* \a \b \f \n \r \t \v */ return pl_escape_char[p - pl_escape_symbol]; if (!Flag_Value(strict_iso)) { if (c == 's') /* \s = space */ return ' '; if (c == 'e') /* ESCAPE */ return 27; } if (c == 'x' || ('0' <= c && c <= '7')) /* \xnn\ \nn\ */ { if (c == 'x') { radix = 16; f = "0123456789abcdefABCDEF"; x = 0; } else { radix = 8; f = "01234567"; x = c - '0'; } Read_Next_Char(pstm, convert); while ((p = strchr(f, c)) != NULL) { i = p - f; if (i >= 16) i -= 6; x = x * radix + i; Read_Next_Char(pstm, convert); } if (!Is_Valid_Code(x)) { if (err_msg == NULL) { pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; err_msg = "invalid character code in \\constant\\ sequence"; } goto pump; } if (c != '\\') { if (err_msg == NULL) { pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; err_msg = "\\ expected in \\constant\\ sequence"; } /* pump until \ or closing quote or newline is found */ pump: while(c != '\\' && c != c0 && c != EOF && c != '\n') Read_Next_Char(pstm, convert); if (c == c0) Unget_Last_Char; /* to be able to continue in the parent's loop */ return -6; /* -6 means other error */ } return (int) (unsigned char) x; } if (err_msg == NULL) { pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; err_msg = "unknown escape sequence"; } return -6; /* -6 means other error */ } /*-------------------------------------------------------------------------* * PL_RECOVER_AFTER_ERROR * * * * Finds the next full stop (to restart after an error) * *-------------------------------------------------------------------------*/ void Pl_Recover_After_Error(StmInf *pstm) #define Next_Char Read_Next_Char(pstm, convert); if (c == EOF) return { int c0; Bool convert; Bool dot_found; if (pstm->eof_reached) return; for (;;) { loop: convert = FALSE; Next_Char; if (c == '.') { Next_Char; if (c_type & (LA | CM)) return; /* full stop found */ } if ((c_type & (QT | DQ | BQ)) == 0) continue; /* quoted pl_token */ c0 = c; convert = (c_orig != '\''); dot_found = FALSE; for (;;) { Next_Char; if (c == c0) /* detect end of pl_token - also for '' or "" or `` */ break; if (c == '.') dot_found = TRUE; else if ((c_type & (LA | CM)) == 0) dot_found = FALSE; if (c == '\n') /* detect newline inside a quoted token: stop */ { if (dot_found) /* consider 'xxxx. followed by newline as a full stop */ return; break; /* else break the quoted token traversal */ } if (c != '\\') continue; /* escape sequence */ Next_Char; if (c == '\n') /* \ followed by newline */ continue; if (c == '.') dot_found = TRUE; if (strchr("\\'\"`", c)) /* \\ or \' or \" or \` " */ continue; if (strchr(pl_escape_symbol, c)) /* \a \b \f \n \r \t \v */ continue; if (c != 'x' && (c < '0' || c > '7')) continue; for (;;) /* \xnn\ \nn\ */ { /* simply find terminal \ */ Next_Char; if (c == c0) goto loop; if (c == '\\' || !isxdigit(c)) break; } } } } /* Other Scanner facilities */ /*-------------------------------------------------------------------------* * PL_SCAN_NEXT_ATOM * * * * Scan the next atom. * *-------------------------------------------------------------------------*/ char * Pl_Scan_Next_Atom(StmInf *pstm) { char *s; err_msg = NULL; do Read_Next_Char(pstm, TRUE); while (c_type == LA); /* layout character */ pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; switch (c_type) { case SL: /* small letter */ s = pl_token.name; do { *s++ = c; Read_Next_Char(pstm, TRUE); } while (c_type & (UL | CL | SL | DI)); *s = '\0'; Unget_Last_Char; break; case DQ: /* double quote */ if ((Flag_Value(double_quotes) & PF_QUOT_AS_PART_MASK) != PF_QUOT_AS_ATOM) goto error; goto do_scan_quoted; case BQ: /* back quote */ if ((Flag_Value(back_quotes) & PF_QUOT_AS_PART_MASK) != PF_QUOT_AS_ATOM) goto error; case QT: /* quote */ do_scan_quoted: err_msg = NULL; Scan_Quoted(pstm); if (err_msg) return err_msg; break; case GR: /* graphic */ s = pl_token.name; while (c_type == GR) { *s++ = c; Read_Next_Char(pstm, TRUE); } *s = '\0'; Unget_Last_Char; break; case SC: /* solo character */ pl_token.name[0] = c; pl_token.name[1] = '\0'; break; default: error: Unget_Last_Char; return "cannot start an atom (use quotes ?)"; } pl_token.type = TOKEN_NAME; return NULL; } /*-------------------------------------------------------------------------* * PL_SCAN_NEXT_NUMBER * * * * Scan the next number (integer if integer_only is TRUE). * *-------------------------------------------------------------------------*/ char * Pl_Scan_Next_Number(StmInf *pstm, Bool integer_only) { Bool minus_op = FALSE; err_msg = NULL; for (;;) { Read_Next_Char(pstm, TRUE); if (c_type != LA) /* layout character */ break; } pl_token.line = pstm->line_count + 1; pl_token.col = pstm->line_pos; if (c == '-' #ifdef MINUS_SIGN_CANNOT_BE_FOLLOWED_BY_SPACES && isdigit(Pl_Scan_Peek_Char(pstm, FALSE)) /* negative number */ #endif ) { for (;;) { Read_Next_Char(pstm, TRUE); if (c_type != LA) /* layout character */ break; } minus_op = TRUE; } if (c_type != DI) { Unget_Last_Char; return "cannot start a number"; } Scan_Number(pstm, integer_only); if (err_msg != NULL) return err_msg; if (minus_op) { if (pl_token.type == TOKEN_INTEGER) { if (pl_token.int_num > -INT_LOWEST_VALUE) return "integer underflow (exceeds min_integer)"; pl_token.int_num = -pl_token.int_num; } else pl_token.float_num = -pl_token.float_num; } else if (pl_token.type == TOKEN_INTEGER && pl_token.int_num > INT_GREATEST_VALUE) return "integer overflow (exceeds max_integer)"; return NULL; } ���������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/g_var_inl_c.c��������������������������������������������������������������0000644�0001750�0001750�00000120744�13021324543�015715� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : g_var_inl_c.c * * Descr.: global variable (inline) management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #define OBJ_INIT G_Var_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define G_INITIAL_VALUE Tag_INT(0) #define G_ARRAY 0 #define G_ARRAY_AUTO 1 #define G_ARRAY_EXTEND 2 #define G_IMPOSSIBLE_SIZE ((unsigned int) -1 >> 1) #define MAX_AUTO_SIZE (1 << 20) /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct gundo *PGUndo; typedef struct /* Global variable element */ { /* ------------------------------ */ int size; /* <0:-array dim, 0:link, >0:copy */ WamWord val; /* ptr to GVarElt or term or adr */ PGUndo undo; /* ptr to 1st undo for this elem */ } GVarElt; typedef struct gundo /* Undo record */ { /* ------------------------------ */ GVarElt *g_elem; /* elem to restore (NULL=invalid) */ int save_size; /* size to restore */ WamWord save_val; /* value to restore */ PGUndo next; /* chain to next undo entry */ PGUndo prev; /* chain to previous undo entry */ } GUndo; typedef struct /* Target designator record */ { /* ------------------------------ */ GVarElt *g_elem; /* element */ WamWord *g_arg; /* ptr to sub-term (or NULL) */ } GTarget; /*---------------------------------* * Global Variables * *---------------------------------*/ static GTarget g_target; static int atom_g_array; static int atom_g_array_auto; static int atom_g_array_extend; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void G_Assign(WamWord gvar_word, WamWord gval_word, Bool backtrack, Bool copy); static void G_Assign_Element(GVarElt *g_elem, WamWord gval_word, Bool backtrack, Bool copy); static void G_Assign_Arg(GVarElt *g_elem, WamWord *g_arg, WamWord word); static void G_Assign_Array(GVarElt *g_elem, WamWord *stc_adr, int array_op, Bool backtrack, Bool copy); static GVarElt *G_Alloc_Array(GVarElt *g_elem, int new_size, Bool backtrack); static GTarget *Get_Target_From_Gvar(WamWord gvar_word); static GTarget *Get_Target_From_Selector(WamWord *stc_adr); static WamWord *Get_Term_Addr_From_Target(GTarget *gt); static WamWord *Get_Int_Addr_From_Gvar(WamWord gvar_word); static PlLong Get_Int_From_Gvar(WamWord gvar_word); static PlLong Get_Int_From_Word(WamWord start_word); static void G_Free_Element(GVarElt *g_elem, Bool reinit_undo); static void G_Copy_Element(GVarElt *dst_g_elem, GVarElt *src_g_elem); static void G_Trail_For_Backtrack(GVarElt *g_elem, int save_size, WamWord save_val); static void G_Untrail(int n, WamWord *arg_frame); static Bool G_Read(WamWord gvar_word, WamWord gval_word); static Bool G_Read_Element(GVarElt *g_elem, WamWord gval_word); static Bool G_Array_Size(WamWord gvar_word, WamWord size_word); static Bool G_Inc_Dec(WamWord gvar_word, int inc, WamWord old_word, WamWord new_word); static void G_Set_Bit(WamWord gvar_word, WamWord bit_word); static void G_Reset_Bit(WamWord gvar_word, WamWord bit_word); static Bool G_Test_Set_Bit(WamWord gvar_word, WamWord bit_word); static Bool G_Test_Reset_Bit(WamWord gvar_word, WamWord bit_word); /*-------------------------------------------------------------------------* * G_VAR_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void G_Var_Initializer(void) { atom_g_array = Pl_Create_Atom("g_array"); atom_g_array_auto = Pl_Create_Atom("g_array_auto"); atom_g_array_extend = Pl_Create_Atom("g_array_extend"); } /*-------------------------------------------------------------------------* * PL_BLT_G_ASSIGN * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Assign(WamWord x, WamWord y) { Pl_Set_C_Bip_Name("g_assign", 2); G_Assign(x, y, FALSE, TRUE); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_ASSIGNB * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Assignb(WamWord x, WamWord y) { Pl_Set_C_Bip_Name("g_assignb", 2); G_Assign(x, y, TRUE, TRUE); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_LINK * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Link(WamWord x, WamWord y) { Pl_Set_C_Bip_Name("g_link", 2); G_Assign(x, y, TRUE, FALSE); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_READ * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Read(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_read", 2); res = G_Read(x, y); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_ARRAY_SIZE * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Array_Size(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_array_size", 2); res = G_Array_Size(x, y); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_INC * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Inc(WamWord x) { Pl_Set_C_Bip_Name("g_inc", 1); G_Inc_Dec(x, 1, NOT_A_WAM_WORD, NOT_A_WAM_WORD); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_INCO * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Inco(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_inco", 2); res = G_Inc_Dec(x, 1, y, NOT_A_WAM_WORD); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_INC_2 * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Inc_2(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_inc", 2); res = G_Inc_Dec(x, 1, NOT_A_WAM_WORD, y); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_INC_3 * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Inc_3(WamWord x, WamWord y, WamWord z) { Bool res; Pl_Set_C_Bip_Name("g_inc", 3); res = G_Inc_Dec(x, 1, y, z); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_DEC * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Dec(WamWord x) { Pl_Set_C_Bip_Name("g_dec", 1); G_Inc_Dec(x, -1, NOT_A_WAM_WORD, NOT_A_WAM_WORD); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_DECO * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Deco(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_deco", 2); res = G_Inc_Dec(x, -1, y, NOT_A_WAM_WORD); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_DEC_2 * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Dec_2(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_dec", 2); res = G_Inc_Dec(x, -1, NOT_A_WAM_WORD, y); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_DEC_3 * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Dec_3(WamWord x, WamWord y, WamWord z) { Bool res; Pl_Set_C_Bip_Name("g_dec", 3); res = G_Inc_Dec(x, -1, y, z); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_SET_BIT * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Set_Bit(WamWord x, WamWord y) { Pl_Set_C_Bip_Name("g_set_bit", 2); G_Set_Bit(x, y); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_RESET_BIT * * * *-------------------------------------------------------------------------*/ void FC Pl_Blt_G_Reset_Bit(WamWord x, WamWord y) { Pl_Set_C_Bip_Name("g_reset_bit", 2); G_Reset_Bit(x, y); Pl_Unset_C_Bip_Name(); } /*-------------------------------------------------------------------------* * PL_BLT_G_TEST_SET_BIT * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Test_Set_Bit(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_test_set_bit", 2); res = G_Test_Set_Bit(x, y); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_G_TEST_RESET_BIT * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_G_Test_Reset_Bit(WamWord x, WamWord y) { Bool res; Pl_Set_C_Bip_Name("g_test_reset_bit", 2); res = G_Test_Reset_Bit(x, y); Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * Global variable management * * * * A global variable allows the user to associate an information to an atom* * There are 3 types of information (2 basic types + 1 constructor): * * * * - copy of a term, builtin: g_assign[b](Gvar, Term) * * - link to a term, builtin: g_link(Gvar, Term) * * - array of k infos, builtin: g_{assign[b]/link}(Gvar, g_array(...)) * * * * The assignments can be backtrackble (g_assignb/g_link) or not (g_assign)* * (backtrackable = assignments are undone when backtracking occurs). * * * * Internal represention: * * * * An information has a type GVarElt which is a structure with 3 fields * * 'size' (indicating the type of the element), 'val' and 'undo': * * * * size<0: an array of -size + 1 elements, * * val (GVarElt *) points the first element. * * after the -size elements there is an additional elem whose size:* * = G_IMPOSSIBLE_SIZE to indicate a non-auto extendible array * * != G_IMPOSSIBLE_SIZE indicate the elem to initialize new elems * * * * size=0: a link to a term, * * val (WamWord) is the staring word of the term. * * * * size>0: a copy of a term whose size is 'size', * * val (WamWord *) is the address of the copy of the term * * (space for the copy obtained by malloc). * * * * 'undo': points to an undo record which will be activated at backtracking* * when untrail occurs. Basically an undo record contains the * * address of the GVarElt to restore and the data to restore * * (size and val). Since several undo operation can be attached to * * a GVarElt, the undo records are chained (dobly linked chain). * * When an undo entry becomes invalid, the address of the GVarElt * * to restore is set to NULL, e.g: * * g_assign(t,1), g_assignb(t,2), g_assign(t,3). * * after g_assignb(t,2) there is an undo record for t which is * * invalidated when g_assign(t,3) occurs. * * The undo records are mallocated but could be put in the TRAIL * * as the frame argument for the function call (TFC). * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * G_ASSIGN * * * *-------------------------------------------------------------------------*/ static void G_Assign(WamWord gvar_word, WamWord gval_word, Bool backtrack, Bool copy) { GTarget *gt = Get_Target_From_Gvar(gvar_word); GVarElt *g_elem = gt->g_elem; WamWord *g_arg = gt->g_arg; if (g_arg != NULL) /* arg selector given */ { if (backtrack) Pl_Err_Domain(pl_domain_g_argument_selector, gvar_word); G_Assign_Arg(g_elem, g_arg, gval_word); } else G_Assign_Element(g_elem, gval_word, backtrack, copy); } /*-------------------------------------------------------------------------* * G_ASSIGN_ELEMENT * * * *-------------------------------------------------------------------------*/ static void G_Assign_Element(GVarElt *g_elem, WamWord gval_word, Bool backtrack, Bool copy) { WamWord word, tag_mask; WamWord *adr; int size; int atom; int save_size; WamWord save_val; int array_op; save_size = g_elem->size; save_val = g_elem->val; DEREF(gval_word, word, tag_mask); if (tag_mask != TAG_STC_MASK) goto not_an_array; adr = UnTag_STC(word); atom = Functor(adr); if (atom == atom_g_array) array_op = G_ARRAY; else if (atom == atom_g_array_auto) array_op = G_ARRAY_AUTO; else if (atom == atom_g_array_extend) array_op = G_ARRAY_EXTEND; else goto not_an_array; /* an array */ G_Assign_Array(g_elem, adr, array_op, backtrack, copy); goto finish; not_an_array: if (!backtrack) G_Free_Element(g_elem, TRUE); if (!copy || tag_mask == TAG_ATM_MASK || tag_mask == TAG_INT_MASK) { /* a link */ if (tag_mask == TAG_REF_MASK && Is_A_Local_Adr(adr = UnTag_REF(word))) Globalize_Local_Unbound_Var(adr, word); g_elem->size = 0; Do_Copy_Of_Word(tag_mask, word); g_elem->val = word; goto finish; } /* a copy */ size = Pl_Term_Size(word); adr = (WamWord *) Malloc(size * sizeof(WamWord)); g_elem->size = size; g_elem->val = (WamWord) adr; Pl_Copy_Term(adr, &word); finish: if (backtrack) G_Trail_For_Backtrack(g_elem, save_size, save_val); } /*-------------------------------------------------------------------------* * G_ASSIGN_ARG * * * *-------------------------------------------------------------------------*/ static void G_Assign_Arg(GVarElt *g_elem, WamWord *g_arg, WamWord word) { WamWord *adr; int size; GUndo *u; if (Pl_Term_Size(*g_arg) == 1 && Pl_Term_Size(word) == 1) { Pl_Copy_Term(g_arg, &word); /* simulate the G_Free_Element */ for(u = g_elem->undo; u; u = u->next) u->g_elem = NULL; /* invalidate this entry */ g_elem->undo = NULL; return; } /* similar to g_read + g_assign */ *g_arg = word; /* set the argument */ Pl_Copy_Term(H, (WamWord *) g_elem->val); G_Free_Element(g_elem, TRUE); size = Pl_Term_Size(*H); adr = (WamWord *) Malloc(size * sizeof(WamWord)); g_elem->size = size; g_elem->val = (WamWord) adr; Pl_Copy_Contiguous_Term(adr, H); } /*-------------------------------------------------------------------------* * G_ASSIGN_ARRAY * * * *-------------------------------------------------------------------------*/ static void G_Assign_Array(GVarElt *g_elem, WamWord *stc_adr, int array_op, Bool backtrack, Bool copy) { WamWord word, tag_mask; int arity; Bool same_init_value; WamWord init_word; WamWord lst_word; PlLong new_size, size; GVarElt *p; int i; arity = Arity(stc_adr); DEREF(Arg(stc_adr, 0), word, tag_mask); new_size = (tag_mask == TAG_LST_MASK) ? Pl_List_Length(word) : UnTag_INT(word); if (!(new_size > 0 && ((tag_mask == TAG_INT_MASK && arity <= 2) || (tag_mask == TAG_LST_MASK && arity == 1)))) Pl_Err_Domain(pl_domain_g_array_index, Tag_STC(stc_adr)); if (tag_mask == TAG_INT_MASK) { same_init_value = TRUE; init_word = (arity == 1) ? G_INITIAL_VALUE : Arg(stc_adr, 1); } else { same_init_value = FALSE; lst_word = word; } if (array_op == G_ARRAY_EXTEND && g_elem->size >= 0) array_op = G_ARRAY; if (array_op != G_ARRAY_EXTEND && !backtrack) { G_Free_Element(g_elem, TRUE); g_elem->size = 0; } size = -g_elem->size; p = G_Alloc_Array(g_elem, new_size, backtrack); if (array_op == G_ARRAY_EXTEND) { if (!same_init_value) for(i = 0; i < size; i++) /* skip size 1st elems of list */ { Pl_Get_List(lst_word); init_word = Pl_Unify_Variable(); lst_word = Pl_Unify_Variable(); } i = size; p += size; } else i = 0; for (; i < new_size; i++) { if (!same_init_value) { Pl_Get_List(lst_word); init_word = Pl_Unify_Variable(); lst_word = Pl_Unify_Variable(); } p->size = 0; p->val = G_INITIAL_VALUE; p->undo = NULL; G_Assign_Element(p++, init_word, FALSE, copy); } if (array_op == G_ARRAY_AUTO) { if (!same_init_value) init_word = G_INITIAL_VALUE; p->size = 0; p->val = G_INITIAL_VALUE; p->undo = NULL; G_Assign_Element(p, init_word, FALSE, copy); } } /*-------------------------------------------------------------------------* * G_ALLOC_ARRAY * * * * Set in g_elem an array for new_size elements. * * If g_elem does not already contain an array a space is mallocated and * * the last elem is initilized with G_IMPOSSIBLE_SIZE. * * * * If g_elem containts an array, its values should be reflected to the new * * array. In absence of backtrackable assignment we perform a realloc else * * a malloc + copy. In both cases the last element is set (copy of old one)* * In case of backtrable assignment (i.e. malloc+copy), the new elements * * should not have undo records (G_Copy_Element sets them to NULL). * * While in case of realloc, the undo records have to been adjusted to * * point to new cells (realloc can return a different starting address). * *-------------------------------------------------------------------------*/ static GVarElt * G_Alloc_Array(GVarElt *g_elem, int new_size, Bool backtrack) { GVarElt *p, *p_new_end, *src, *dst; GUndo *u; int old_size, i; old_size = -g_elem->size; src = (GVarElt *) g_elem->val; if (old_size <= 0 || backtrack) p = (GVarElt *) Malloc((new_size + 1) * sizeof(GVarElt)); else p = (GVarElt *) Realloc((char *) src, (new_size + 1) * sizeof(GVarElt)); p_new_end = p + new_size; if (old_size <= 0) { /* init last elem */ p_new_end->size = G_IMPOSSIBLE_SIZE; p_new_end->val = (WamWord) NULL; p_new_end->undo = NULL; goto finish; } /* there is an array at *src */ if (backtrack) { dst = p; for (i = 0; i < old_size; i++) G_Copy_Element(dst++, src++); /* copy last elem */ if (src->size != G_IMPOSSIBLE_SIZE) G_Copy_Element(p_new_end, src); else *p_new_end = *src; goto finish; } /* a realloc */ dst = p; for (i = 0; i < old_size; i++) { for (u = dst->undo; u; u = u->next) u->g_elem = dst; dst++; } *p_new_end = *dst; /* copy last elem */ finish: g_elem->size = -new_size; g_elem->val = (WamWord) p; return p; } /*-------------------------------------------------------------------------* * GET_TARGET_FROM_GVAR * * * *-------------------------------------------------------------------------*/ static GTarget * Get_Target_From_Gvar(WamWord gvar_word) { WamWord word, tag_mask; WamWord word1; int atom; int arity; WamWord *arg_adr; GVarElt *g_elem, *g_end; GVarElt *p; int i, j, size; int new_size; PlLong index; GTarget *gt = &g_target; arg_adr = Pl_Rd_Callable_Check(gvar_word, &atom, &arity); if (atom == ATOM_CHAR('-') && arity == 2) return Get_Target_From_Selector(arg_adr - OFFSET_ARG); g_elem = (GVarElt *) pl_atom_tbl[atom].info; if (g_elem == NULL) { g_elem = (GVarElt *) Malloc(sizeof(GVarElt)); /* NB: never recovered */ g_elem->size = 0; g_elem->val = G_INITIAL_VALUE; g_elem->undo = NULL; pl_atom_tbl[atom].info = g_elem; } if (arity > 0 && g_elem->size >= 0) { error: Pl_Err_Domain(pl_domain_g_array_index, gvar_word); } for (i = 0; i < arity; i++) { size = g_elem->size; word1 = *arg_adr; DEREF(word1, word, tag_mask); if (tag_mask != TAG_INT_MASK) /* follow the indirection */ word = *Get_Int_Addr_From_Gvar(word); index = UnTag_INT(word); if (size >= 0 || index < 0) goto error; size = -size; if (index >= size) { p = (GVarElt *) (g_elem->val); g_end = p + size; if (g_end->size == G_IMPOSSIBLE_SIZE || index > MAX_AUTO_SIZE) goto error; /* auto expand */ for(new_size = 1; new_size <= index; new_size <<= 1) ; p = G_Alloc_Array(g_elem, new_size, FALSE); g_end = p + new_size; p += size; for (j = size; j < new_size; j++) /* init new cells */ G_Copy_Element(p++, g_end); } g_elem = (GVarElt *) (g_elem->val) + index; arg_adr++; } gt->g_elem = g_elem; gt->g_arg = NULL; return gt; } /*-------------------------------------------------------------------------* * GET_TARGET_FROM_SELECTOR * * * *-------------------------------------------------------------------------*/ static GTarget * Get_Target_From_Selector(WamWord *stc_adr) { WamWord word, tag_mask; WamWord *adr, word1; int arg_no; GTarget *gt; gt = Get_Target_From_Gvar(Arg(stc_adr, 0)); arg_no = Get_Int_From_Word(Arg(stc_adr, 1)); adr = Get_Term_Addr_From_Target(gt); if (adr == NULL) /* an array */ goto error; word1 = *adr; DEREF(word1, word, tag_mask); if (tag_mask == STC) { adr = UnTag_STC(word); if (arg_no < 1 || arg_no > Arity(adr)) goto error; gt->g_arg = &Arg(adr, arg_no - 1); } else if (tag_mask == LST) { adr = UnTag_LST(word); if (arg_no < 0) goto error; while(--arg_no) { DEREF(Cdr(adr), word, tag_mask); if (tag_mask != LST) goto error; adr = UnTag_LST(word); } gt->g_arg = &Car(adr); } else { error: Pl_Err_Domain(pl_domain_g_argument_selector, Tag_STC(stc_adr)); } return gt; } /*-------------------------------------------------------------------------* * GET_TERM_ADDR_FROM_TARGET * * * *-------------------------------------------------------------------------*/ static WamWord * Get_Term_Addr_From_Target(GTarget *gt) { GVarElt *g_elem = gt->g_elem; if (gt->g_arg) return gt->g_arg; if (g_elem->size < 0) return NULL; if (g_elem->size == 0) return (WamWord *) &g_elem->val; return (WamWord *) g_elem->val; } /*-------------------------------------------------------------------------* * GET_INT_ADDR_FROM_GVAR * * * *-------------------------------------------------------------------------*/ static WamWord * Get_Int_Addr_From_Gvar(WamWord gvar_word) { GTarget save_g_target = g_target; /* save for cross-recursion */ GTarget *gt = Get_Target_From_Gvar(gvar_word); WamWord *adr = Get_Term_Addr_From_Target(gt); g_target = save_g_target; /* should be dereferenced */ if (adr == NULL) /* an array */ Pl_Err_Type(pl_type_integer, Tag_ATM(atom_g_array)); if (Tag_Mask_Of(*adr) != TAG_INT_MASK) Pl_Err_Type(pl_type_integer, *adr); return adr; } /*-------------------------------------------------------------------------* * GET_INT_FROM_GVAR * * * *-------------------------------------------------------------------------*/ static PlLong Get_Int_From_Gvar(WamWord gvar_word) { return *Get_Int_Addr_From_Gvar(gvar_word); } /*-------------------------------------------------------------------------* * GET_INT_FROM_WORD * * * *-------------------------------------------------------------------------*/ static PlLong Get_Int_From_Word(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask != TAG_INT_MASK) /* follow the indirection */ word = *Get_Int_Addr_From_Gvar(word); return UnTag_INT(word); } /*-------------------------------------------------------------------------* * G_FREE_ELEMENT * * * *-------------------------------------------------------------------------*/ static void G_Free_Element(GVarElt *g_elem, Bool reinit_undo) { int size; GVarElt *p; GUndo *u; int i; if (reinit_undo) { for(u = g_elem->undo; u; u = u->next) u->g_elem = NULL; /* invalidate this entry */ g_elem->undo = NULL; } size = g_elem->size; if (size == 0) /* a link: nothing */ return; if (size < 0) /* an array: recursively free elts */ { size = -size; p = (GVarElt *) (g_elem->val); for (i = 0; i < size; i++) G_Free_Element(p++, reinit_undo); if (p->size != G_IMPOSSIBLE_SIZE) /* last elem */ G_Free_Element(p, reinit_undo); } /* a copy or an array: free */ Free((char *) g_elem->val); } /*-------------------------------------------------------------------------* * G_COPY_ELEMENT * * * *-------------------------------------------------------------------------*/ static void G_Copy_Element(GVarElt *dst_g_elem, GVarElt *src_g_elem) { WamWord *adr; GVarElt *p; int size; int i; size = dst_g_elem->size = src_g_elem->size; dst_g_elem->undo = NULL; if (size == 0) /* a link: copy */ { dst_g_elem->val = src_g_elem->val; return; } if (size < 0) /* an array: alloc + recursively copy elts */ { size = -size; p = (GVarElt *) Malloc((size + 1) * sizeof(GVarElt)); dst_g_elem->val = (WamWord) p; dst_g_elem = p; src_g_elem = (GVarElt *) (src_g_elem->val); for (i = 0; i < size; i++) G_Copy_Element(dst_g_elem++, src_g_elem++); if (src_g_elem->size == G_IMPOSSIBLE_SIZE) /* last elem */ *dst_g_elem = *src_g_elem; else G_Copy_Element(dst_g_elem, src_g_elem); return; } /* a copy: alloc + copy */ adr = (WamWord *) Malloc(size * sizeof(WamWord)); dst_g_elem->val = (WamWord) adr; Pl_Copy_Contiguous_Term(adr, (WamWord *) src_g_elem->val); } /*-------------------------------------------------------------------------* * G_TRAIL_FOR_BACKTRACK * * * *-------------------------------------------------------------------------*/ static void G_Trail_For_Backtrack(GVarElt *g_elem, int save_size, WamWord save_val) { WamWord arg_frame[1]; GUndo *u = (GUndo *) Malloc(sizeof(GUndo)); u->g_elem = g_elem; u->save_size = save_size; u->save_val = save_val; u->next = g_elem->undo; u->prev = NULL; if (u->next) u->next->prev = u; g_elem->undo = u; arg_frame[0] = (WamWord) u; Trail_FC(G_Untrail, 1, arg_frame); } /*-------------------------------------------------------------------------* * G_UNTRAIL * * * *-------------------------------------------------------------------------*/ static void G_Untrail(int n, WamWord *arg_frame) { GUndo *u = (GUndo *) arg_frame[0]; GVarElt *g_elem = u->g_elem; if (g_elem) /* valid entry ? */ { G_Free_Element(g_elem, FALSE); g_elem->size = u->save_size; g_elem->val = u->save_val; } /* remove undo record */ if (u->next) u->next->prev = u->prev; if (u->prev) u->prev->next = u->next; else if (g_elem) g_elem->undo = u->next; Free(u); } /*-------------------------------------------------------------------------* * G_READ * * * *-------------------------------------------------------------------------*/ static Bool G_Read(WamWord gvar_word, WamWord gval_word) { GTarget *gt = Get_Target_From_Gvar(gvar_word); GVarElt *g_elem = gt->g_elem; WamWord *g_arg = gt->g_arg; WamWord word; if (g_arg != NULL) { Pl_Copy_Term(H, g_arg); word = *H; H += Pl_Term_Size(word); return Pl_Unify(word, gval_word); } return G_Read_Element(g_elem, gval_word); } /*-------------------------------------------------------------------------* * G_READ_ELEMENT * * * *-------------------------------------------------------------------------*/ static Bool G_Read_Element(GVarElt *g_elem, WamWord gval_word) { WamWord word; int size = g_elem->size; GVarElt *p; int i; if (size == 0) /* a link: unify */ return Pl_Unify(g_elem->val, gval_word); if (size > 0) /* a copy: copy+unify */ { Pl_Copy_Contiguous_Term(H, (WamWord *) g_elem->val); word = *H; H += size; return Pl_Unify(word, gval_word); } /* an array: unify with g_array([elt,...]) */ size = -size; p = (GVarElt *) g_elem->val; if (!Pl_Get_Structure(atom_g_array, 1, gval_word)) return FALSE; gval_word = Pl_Unify_Variable(); for (i = 0; i < size; i++) { if (!Pl_Get_List(gval_word)) return FALSE; word = Pl_Unify_Variable(); gval_word = Pl_Unify_Variable(); if (!G_Read_Element(p++, word)) return FALSE; } return Pl_Get_Nil(gval_word); } /*-------------------------------------------------------------------------* * G_ARRAY_SIZE * * * *-------------------------------------------------------------------------*/ static Bool G_Array_Size(WamWord gvar_word, WamWord size_word) { GTarget *gt = Get_Target_From_Gvar(gvar_word); GVarElt *g_elem = gt->g_elem; WamWord *g_arg = gt->g_arg; int size; Pl_Check_For_Un_Integer(size_word); size = g_elem->size; return g_arg == NULL && size < 0 && Pl_Get_Integer(-size, size_word); } /*-------------------------------------------------------------------------* * G_INC_DEC * * * *-------------------------------------------------------------------------*/ static Bool G_Inc_Dec(WamWord gvar_word, int inc, WamWord old_word, WamWord new_word) { WamWord *adr; PlLong old, new; if (old_word != NOT_A_WAM_WORD) Pl_Check_For_Un_Integer(old_word); if (new_word != NOT_A_WAM_WORD) Pl_Check_For_Un_Integer(new_word); adr = Get_Int_Addr_From_Gvar(gvar_word); old = UnTag_INT(*adr); new = old + inc; if (old_word != NOT_A_WAM_WORD && !Pl_Get_Integer(old, old_word)) return FALSE; *adr = Tag_INT(new); /* increment now - cf specif in doc */ if (new_word != NOT_A_WAM_WORD && !Pl_Get_Integer(new, new_word)) return FALSE; return TRUE; } /*-------------------------------------------------------------------------* * G_SET_BIT * * * *-------------------------------------------------------------------------*/ static void G_Set_Bit(WamWord gvar_word, WamWord bit_word) { WamWord *adr; int bit = Pl_Rd_Positive_Check(bit_word) % VALUE_SIZE; PlULong mask; adr = Get_Int_Addr_From_Gvar(gvar_word); mask = 1 << (bit + TAG_SIZE_LOW); *adr |= mask; } /*-------------------------------------------------------------------------* * G_RESET_BIT * * * *-------------------------------------------------------------------------*/ static void G_Reset_Bit(WamWord gvar_word, WamWord bit_word) { WamWord *adr; int bit = Pl_Rd_Positive_Check(bit_word) % VALUE_SIZE; PlULong mask; adr = Get_Int_Addr_From_Gvar(gvar_word); mask = 1 << (bit + TAG_SIZE_LOW); *adr &= ~mask; } /*-------------------------------------------------------------------------* * G_TEST_SET_BIT * * * *-------------------------------------------------------------------------*/ static Bool G_Test_Set_Bit(WamWord gvar_word, WamWord bit_word) { int bit = Pl_Rd_Positive_Check(bit_word) % VALUE_SIZE; PlULong val, mask; val = Get_Int_From_Gvar(gvar_word); mask = 1 << (bit + TAG_SIZE_LOW); return (val & mask) != 0; } /*-------------------------------------------------------------------------* * G_TEST_RESET_BIT * * * *-------------------------------------------------------------------------*/ static Bool G_Test_Reset_Bit(WamWord gvar_word, WamWord bit_word) { int bit = Pl_Rd_Positive_Check(bit_word) % VALUE_SIZE; PlULong mask, val; val = Get_Int_From_Gvar(gvar_word); mask = 1 << (bit + TAG_SIZE_LOW); return (val & mask) == 0; } ����������������������������gprolog-1.4.5/src/BipsPl/oper_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000025455�13021324543�014725� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : oper_c.c * * Descr.: operator management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #define OBJ_INIT Oper_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define FX 0 #define FY 1 #define XF 2 #define YF 3 #define XFX 4 #define XFY 5 #define YFX 6 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int atom_specif_tbl[7]; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int Detect_Oper_Specif(OperInf *oper); #define CURRENT_OP_ALT X1_2463757272656E745F6F705F616C74 Prolog_Prototype(CURRENT_OP_ALT, 0); /*-------------------------------------------------------------------------* * OPER_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Oper_Initializer(void) { char *a[7] = { "fx", "fy", "xf", "yf", "xfx", "xfy", "yfx" }; int i; for (i = 0; i < 7; i++) atom_specif_tbl[i] = Pl_Create_Atom(a[i]); } /*-------------------------------------------------------------------------* * PL_OP_3 * * * *-------------------------------------------------------------------------*/ void Pl_Op_3(WamWord prec_word, WamWord specif_word, WamWord oper_word) { int atom_op; int prec; int atom_specif; int i; int type, left, right; atom_op = Pl_Rd_Atom_Check(oper_word); prec = Pl_Rd_Integer_Check(prec_word); if (prec < 0 || prec > MAX_PREC) Pl_Err_Domain(pl_domain_operator_priority, prec_word); atom_specif = Pl_Rd_Atom_Check(specif_word); for (i = 0; i < 7 && atom_specif != atom_specif_tbl[i]; i++) ; switch (i) { case FX: case FY: type = PREFIX; left = 0; right = (i == FX) ? prec - 1 : prec; break; case XF: case YF: type = POSTFIX; left = (i == XF) ? prec - 1 : prec; right = 0; break; case XFX: case XFY: case YFX: type = INFIX; left = (i == XFX || i == XFY) ? prec - 1 : prec; right = (i == XFX || i == YFX) ? prec - 1 : prec; break; default: Pl_Err_Domain(pl_domain_operator_specifier, specif_word); type = left = right = 0; /* only for the compiler */ } if ((type != PREFIX && Check_Oper(atom_op, (type == POSTFIX) ? INFIX : POSTFIX)) || /* infix + postfix invalid */ (atom_op == ATOM_CHAR('|') && (type != INFIX || (prec > 0 && prec <= 1000))) || /* | no infix or prec <= 1000 */ (atom_op == ATOM_NIL || atom_op == pl_atom_curly_brackets)) /* [] or {} forbidden */ Pl_Err_Permission(pl_permission_operation_create, pl_permission_type_operator, oper_word); if (atom_op == ATOM_CHAR(',')) Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_operator, oper_word); if (prec > 0) Pl_Create_Oper(atom_op, type, prec, left, right); else Pl_Delete_Oper(atom_op, type); } /*-------------------------------------------------------------------------* * PL_CURRENT_OP_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Op_3(WamWord prec_word, WamWord specif_word, WamWord oper_word) { WamWord word, tag_mask; HashScan scan; PlLong prec; int atom_specif; OperInf *oper; int atom; int op_mask; int i; DEREF(oper_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, word); oper_word = word; DEREF(prec_word, word, tag_mask); prec = UnTag_INT(word); if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_INT_MASK || prec < 0 || prec > MAX_PREC)) Pl_Err_Domain(pl_domain_operator_priority, word); prec_word = word; DEREF(specif_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) { atom_specif = UnTag_ATM(word); for (i = 0; i < 7 && atom_specif != atom_specif_tbl[i]; i++) ; } if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_ATM_MASK || i >= 7)) Pl_Err_Domain(pl_domain_operator_specifier, specif_word); specif_word = word; if (Tag_Mask_Of(oper_word) == TAG_ATM_MASK) { atom = UnTag_ATM(oper_word); op_mask = pl_atom_tbl[atom].prop.op_mask; if (op_mask == 0) return FALSE; for (i = PREFIX; i <= POSTFIX; i++) if (op_mask & Make_Op_Mask(i)) break; op_mask &= ~Make_Op_Mask(i); if (op_mask) /* non deterministic case */ { A(0) = prec_word; A(1) = specif_word; A(2) = oper_word; A(3) = op_mask; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_OP_ALT, 0), 4); } oper = Pl_Lookup_Oper(atom, i); } else { oper = (OperInf *) Pl_Hash_First(pl_oper_tbl, &scan); if (oper == NULL) return FALSE; /* non deterministic case */ A(0) = prec_word; A(1) = specif_word; A(2) = oper_word; A(3) = (WamWord) scan.endt; A(4) = (WamWord) scan.cur_t; A(5) = (WamWord) scan.cur_p; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_OP_ALT, 0), 6); } return Pl_Get_Integer(oper->prec, prec_word) && Pl_Get_Atom(Detect_Oper_Specif(oper), specif_word) && Pl_Get_Atom(Atom_Of_Oper(oper->a_t), oper_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_OP_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Op_Alt_0(void) { WamWord prec_word, specif_word, oper_word; HashScan scan; OperInf *oper; int atom; int op_mask; int i; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_OP_ALT, 0), 0); prec_word = AB(B, 0); specif_word = AB(B, 1); oper_word = AB(B, 2); if (Tag_Mask_Of(oper_word) == TAG_ATM_MASK) { atom = UnTag_ATM(oper_word); op_mask = AB(B, 3); for (i = PREFIX; i <= POSTFIX; i++) if (op_mask & Make_Op_Mask(i)) break; oper = Pl_Lookup_Oper(atom, i); Delete_Last_Choice_Point(); } else { scan.endt = (char *) AB(B, 3); scan.cur_t = (char *) AB(B, 4); scan.cur_p = (char *) AB(B, 5); oper = (OperInf *) Pl_Hash_Next(&scan); if (oper == NULL) { Delete_Last_Choice_Point(); return FALSE; } #if 0 /* the following data is unchanged */ AB(B, 0) = prec_word; AB(B, 1) = specif_word; AB(B, 2) = oper_word; AB(B, 3) = (WamWord) scan.endt; #endif AB(B, 4) = (WamWord) scan.cur_t; AB(B, 5) = (WamWord) scan.cur_p; } return Pl_Get_Integer(oper->prec, prec_word) && Pl_Get_Atom(Detect_Oper_Specif(oper), specif_word) && Pl_Get_Atom(Atom_Of_Oper(oper->a_t), oper_word); } /*-------------------------------------------------------------------------* * DETECT_OPER_SPECIF * * * *-------------------------------------------------------------------------*/ static int Detect_Oper_Specif(OperInf *oper) { int prec = oper->prec; int i; switch (Type_Of_Oper(oper->a_t)) { case PREFIX: i = (oper->right) < prec ? FX : FY; break; case POSTFIX: i = (oper->left) < prec ? XF : YF; break; default: /* i.e INFIX: */ i = (oper->left) < prec ? ((oper->right) < prec ? XFX : XFY) : YFX; break; } return atom_specif_tbl[i]; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/scan_supp.h����������������������������������������������������������������0000644�0001750�0001750�00000010361�13021324543�015444� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : scan_supp.h * * Descr.: scanner support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define SCAN_BIG_BUFFER 10240 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef enum { TOKEN_VARIABLE, TOKEN_INTEGER, TOKEN_FLOAT, TOKEN_NAME, TOKEN_STRING, TOKEN_BACK_QUOTED, TOKEN_PUNCTUATION, TOKEN_IMMEDIAT_OPEN, TOKEN_FULL_STOP, TOKEN_END_OF_FILE, TOKEN_EXTENDED } TypTok; typedef struct { TypTok type; char name[SCAN_BIG_BUFFER]; /* for VARIABLE NAME STRING BACK_QUOTED */ int quoted; /* for NAME: was it quoted ? */ int punct; /* for PUNCTUATION */ PlLong int_num; /* for INTEGER */ double float_num; /* for FLOAT */ int line; /* source line of the pl_token */ int col; /* source column of the pl_token */ } TokInf; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef SCAN_SUPP_FILE TokInf pl_token; #else extern TokInf pl_token; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Pl_Scan_Peek_Char(StmInf *pstm, Bool convert); char *Pl_Scan_Token(StmInf *pstm, Bool comma_is_punct); void Pl_Recover_After_Error(StmInf *pstm); char *Pl_Scan_Next_Atom(StmInf *pstm); char *Pl_Scan_Next_Number(StmInf *pstm, Bool integer_only); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/t_c.c����������������������������������������������������������������������0000644�0001750�0001750�00000012473�13021324543�014217� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : development only * * File : t_c.c * * Descr.: test - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * GNU Prolog is free software; you can redistribute it and/or modify it * * under the terms of the GNU General Public License as published by the * * Free Software Foundation; either version 2, or any later version. * * * * GNU Prolog 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. * * 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. * *-------------------------------------------------------------------------*/ /* * You can put your own test code in these files (see src/DEVELOPMENT) * t.pl (Prolog part) * t_c.c (C part, eg. foreign code) */ #include <stdio.h> #include <stdlib.h> #if 0 #include "engine_pl.h" #include "bips_pl.h" #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * * * * *-------------------------------------------------------------------------*/ #if 0 #include <gprolog.h> #include <stdlib.h> Bool segfault( char *in, PlTerm out ) { if( strcmp(in,"yes") == 0 ) { printf("Calling system error\n"); Pl_Err_System(Pl_Create_Atom("segfault_system_error_test")); printf("return\n"); return FALSE; } else { printf("unifying\n"); Pl_Un_String_Check("Hello, World!", out); printf("return\n"); return TRUE; } return FALSE; } #endif #if 0 #include "gprolog.h" int i=0; Bool malloc_test(int size) { void * tmp; i++; tmp = malloc(size); if (tmp == NULL) { printf("FAILED AT %d MB\n", i); exit(1); } printf("OK at: %lx\n", tmp); return TRUE; } #endif #if 0 #include "gprolog.h" int i=0; Bool malloc_test(int size) { void * tmp; i++; tmp = malloc(size); if (tmp == NULL) { Pl_Err_System(Pl_Create_Atom("malloc_test exception")); } printf("OK at: %p\n", tmp); return TRUE; } #endif #if 0 int i=0; Bool malloc_test(int size) { Pl_Err_System(Pl_Create_Atom("malloc_test exception")); return TRUE; } #endif #if 0 #include <string.h> #include "gprolog.h" Bool calling_c(PlTerm In,PlTerm* Out) { PlTerm arg[2]; int i; for(i=0;i<2;i++) arg[i]=X(1); Pl_Query_Begin(TRUE); Pl_Query_Call(Pl_Find_Atom("write"),1,&In); Pl_Query_End(PL_RECOVER); for(i=0;i<2;i++) X(1)=arg[i]; *Out = Pl_Mk_Atom(atom_nil); return PL_SUCCESS; } Bool Is_Kbd_Empty(void) { /* to put in stream_supp.c if (tty_ptr != NULL && *tty_ptr != '\0') return FALSE; */ int result = !Pl_LE_Kbd_Is_Not_Empty(); printf("result: %d\n", result); return result; } #endif #if 0 #include "gprolog.h" int sdl_init(PlTerm list) { unsigned long flags=0; int atom; if(Pl_Builtin_List(list)) { PlTerm *terms=NULL; int len=Pl_List_Length(list); terms=malloc(sizeof(PlTerm)*len); if(terms) { unsigned i; Pl_Rd_Proper_List_Check(list, terms); for(i=0; i<len; i++) { char* s; switch(Pl_Type_Of_Term(terms[i])) { case PL_INT: printf("integer.\n"); flags|=Pl_Rd_Integer(terms[i]); break; case PL_ATM: atom = Pl_Rd_Atom(terms[i]); s=Pl_Atom_Name(atom); printf("atom %s is '%s'\n",s,Pl_Is_Valid_Atom(Pl_Rd_Atom(terms[i])) ? "valid":"invalid"); break; } } } } return PL_TRUE; } #endif #if 0 #include "gprolog.h" Bool My_Disp(PlTerm term, PlTerm t1) { char *s = Pl_Write_To_String(term); return Pl_Unif(Pl_Read_From_String(s), t1); /* printf("my <%s>\n", s); free(s); */ } #endif �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pl_error.pl����������������������������������������������������������������0000644�0001750�0001750�00000007617�13021324543�015473� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pl_error.pl * * Descr.: Prolog error management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. set_bip_name(Name, Arity) :- % it is an inline predicate set_bip_name(Name, Arity). current_bip_name(Name, Arity) :- '$call_c_test'('Pl_Current_Bip_Name_2'(Name, Arity)). '$pl_err_instantiation' :- '$pl_error'(instantiation_error). '$pl_err_uninstantiation'(T) :- '$pl_error'(uninstantiation_error(T)). '$pl_err_type'(Type, T) :- '$pl_error'(type_error(Type, T)). '$pl_err_domain'(Dom, T) :- '$pl_error'(domain_error(Dom, T)). '$pl_err_existence'(Object, T) :- '$pl_error'(existence_error(Object, T)). '$pl_err_permission'(Oper, Perm, T) :- '$pl_error'(permission_error(Oper, Perm, T)). '$pl_err_representation'(Flag) :- '$pl_error'(representation_error(Flag)). '$pl_err_evaluation'(Error) :- '$pl_error'(evaluation_error(Error)). '$pl_err_resource'(Flag) :- '$pl_error'(resource_error(Flag)). '$pl_err_syntax'(T) :- '$pl_error'(syntax_error(T)). '$pl_err_system'(T) :- '$pl_error'(system_error(T)). '$pl_error'(Msg) :- '$call_c'('Pl_Context_Error_1'(ContextAtom)), throw(error(Msg, ContextAtom)). syntax_error_info(FileName, Line, Char, Msg) :- set_bip_name(syntax_error_info, 4), '$call_c_test'('Pl_Syntax_Error_Info_4'(FileName, Line, Char, Msg)). �����������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stream.pl������������������������������������������������������������������0000644�0001750�0001750�00000041366�13021324543�015141� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : stream.pl * * Descr.: stream selection and control management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_stream'. current_input(Stream) :- set_bip_name(current_input, 1), '$check_stream_or_var'(Stream, S), '$call_c_test'('Pl_Current_Input_1'(S)). current_output(Stream) :- set_bip_name(current_output, 1), '$check_stream_or_var'(Stream, S), '$call_c_test'('Pl_Current_Output_1'(S)). '$check_stream_or_var'('$stream'(S), S) :- ( var(S) ; integer(S) ), !. '$check_stream_or_var'(Stream, _) :- '$pl_err_domain'(stream, Stream). set_input(SorA) :- set_bip_name(set_input, 1), '$call_c'('Pl_Set_Input_1'(SorA)). set_output(SorA) :- set_bip_name(set_output, 1), '$call_c'('Pl_Set_Output_1'(SorA)). '$set_top_level_streams'(SorAIn, SorAOut) :- '$call_c'('Pl_Set_Top_Level_Streams_2'(SorAIn, SorAOut)). '$set_debugger_streams'(SorAIn, SorAOut) :- '$call_c'('Pl_Set_Debugger_Streams_2'(SorAIn, SorAOut)). % open mask in sys_var[0]: % % b8 b7 b6 b5 b4 b3 b2 b1 b0 % 0/1 0/1/2 0/1 0/1/2 0/1 0/1 0/1 % buffering eof_action reposition text % b8=specified b5=specified b2=specified 0=text % b7/6=if specif b4/3=if specif b1=if specified 1=binary % buffering eof action reposition % 0=none 0=error 0=false % 1=line 1=eof_code 1=true % 2=block 2=reset open(SourceSink, Mode, Stream) :- set_bip_name(open, 3), '$open'(SourceSink, Mode, Stream, []). open(SourceSink, Mode, Stream, Options) :- set_bip_name(open, 4), '$open'(SourceSink, Mode, Stream, Options). '$open'(SourceSink, Mode, Stream, Options) :- '$set_open_defaults', '$get_open_stm'(Stream, Stm), g_link('$open_aliases', LAlias), g_link('$open_mirrors', LMirror), '$get_open_options'(Options), g_read('$open_aliases', []), % close the list g_read('$open_mirrors', []), % close the list '$call_c'('Pl_Open_3'(SourceSink, Mode, Stm)), '$add_aliases_to_stream'(LAlias, Stream), '$add_mirrors_to_stream'(LMirror, Stream). '$set_open_defaults' :- '$sys_var_write'(0, 1). '$get_open_stm'(Stream, Stm) :- ( nonvar(Stream) -> '$pl_err_uninstantiation'(Stream) ; Stream = '$stream'(Stm) ). '$get_open_options'(Options) :- '$check_list'(Options), '$get_open_options1'(Options). '$get_open_options1'([]). '$get_open_options1'([X|Options]) :- '$get_open_options2'(X), !, '$get_open_options1'(Options). '$get_open_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_open_options2'(type(X)) :- '$check_nonvar'(X), ( X = text, '$sys_var_set_bit'(0, 0) ; X = binary, '$sys_var_reset_bit'(0, 0) ). '$get_open_options2'(reposition(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 1) ; X = true, '$sys_var_set_bit'(0, 1) ), '$sys_var_set_bit'(0, 2). '$get_open_options2'(eof_action(X)) :- '$check_nonvar'(X), ( X = error, '$sys_var_reset_bit'(0, 4), '$sys_var_reset_bit'(0, 3) ; X = eof_code, '$sys_var_reset_bit'(0, 4), '$sys_var_set_bit'(0, 3) ; X = reset, '$sys_var_set_bit'(0, 4), '$sys_var_reset_bit'(0, 3) ), '$sys_var_set_bit'(0, 5). '$get_open_options2'(buffering(X)) :- '$check_nonvar'(X), ( X = none, '$sys_var_reset_bit'(0, 7), '$sys_var_reset_bit'(0, 6) ; X = line, '$sys_var_reset_bit'(0, 7), '$sys_var_set_bit'(0, 6) ; X = block, '$sys_var_set_bit'(0, 7), '$sys_var_reset_bit'(0, 6) ), '$sys_var_set_bit'(0, 8). '$get_open_options2'(alias(X)) :- atom(X), !, ( '$call_c_test'('Pl_Test_Alias_Not_Assigned_1'(X)) -> g_read('$open_aliases', [X|End]), g_link('$open_aliases', End) % write new end variable ; '$pl_err_permission'(open, source_sink, alias(X)) ). '$get_open_options2'(mirror(X)) :- '$check_nonvar'(X), (X = '$stream'(MStm), integer(MStm) ; atom(X)), !, '$call_c'('Pl_Check_Valid_Mirror_1'(X)), g_read('$open_mirrors', [X|End]), g_link('$open_mirrors', End). % write new end variable '$get_open_options2'(X) :- '$pl_err_domain'(stream_option, X). '$add_aliases_to_stream'([], _). '$add_aliases_to_stream'([Alias|LAlias], Stream) :- '$call_c'('Pl_Add_Stream_Alias_2'(Stream, Alias)), '$add_aliases_to_stream'(LAlias, Stream). '$add_mirrors_to_stream'([], _). '$add_mirrors_to_stream'([Mirror|LMirror], Stream) :- '$call_c'('Pl_Add_Stream_Mirror_2'(Stream, Mirror)), '$add_mirrors_to_stream'(LMirror, Stream). % close mask in sys_var[0]: % % b0 % 0/1 % force % 0=false % 1=true close(SorA) :- set_bip_name(close, 1), '$close'(SorA, []). close(SorA, Options) :- set_bip_name(close, 2), '$close'(SorA, Options). '$close'(SorA, Options) :- '$sys_var_write'(0, 0), % default mask '$get_close_options'(Options), '$call_c'('Pl_Close_1'(SorA)). '$get_close_options'(Options) :- '$check_list'(Options), '$get_close_options1'(Options). '$get_close_options1'([]). '$get_close_options1'([X|Options]) :- '$get_close_options2'(X), !, '$get_close_options1'(Options). '$get_close_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_close_options2'(force(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 0) ; X = true, '$sys_var_set_bit'(0, 0) ). '$get_close_options2'(X) :- '$pl_err_domain'(close_option, X). add_stream_alias(SorA, Alias) :- set_bip_name(add_stream_alias, 2), '$call_c_test'('Pl_Add_Stream_Alias_2'(SorA, Alias)), !. add_stream_alias(_, Alias) :- '$pl_err_permission'(add_alias, source_sink, alias(Alias)). add_stream_mirror(SorA, Mirror) :- set_bip_name(add_stream_mirror, 2), '$call_c'('Pl_Add_Stream_Mirror_2'(SorA, Mirror)). remove_stream_mirror(SorA, Mirror) :- set_bip_name(remove_stream_mirror, 2), '$call_c_test'('Pl_Remove_Stream_Mirror_2'(SorA, Mirror)). set_stream_type(SorA, Type) :- set_bip_name(set_stream_type, 2), ( var(Type) -> '$pl_err_instantiation' ; true ), ( Type = text, IsText = 1 ; Type = binary, IsText = 0 ), !, '$call_c'('Pl_Set_Stream_Type_2'(SorA, IsText)). set_stream_type(_, Type) :- '$pl_err_domain'(stream_type, Type). set_stream_eof_action(SorA, EofAction) :- set_bip_name(set_stream_eof_action, 2), ( var(EofAction) -> '$pl_err_instantiation' ; true ), ( EofAction = error, Action = 0 ; EofAction = eof_code, Action = 1 ; EofAction = reset, Action = 2 ), !, '$call_c'('Pl_Set_Stream_Eof_Action_2'(SorA, Action)). set_stream_eof_action(_, EofAction) :- '$pl_err_domain'(eof_action, EofAction). set_stream_buffering(SorA, Buffering) :- set_bip_name(set_stream_buffering, 2), ( var(Buffering) -> '$pl_err_instantiation' ; true ), ( Buffering = none, BuffMode = 0 ; Buffering = line, BuffMode = 1 ; Buffering = block, BuffMode = 2 ), !, '$call_c'('Pl_Set_Stream_Buffering_2'(SorA, BuffMode)). set_stream_buffering(_, Buffering) :- '$pl_err_domain'(buffering_mode, Buffering). '$PB_empty_buffer'(SorA) :- '$call_c'('Pl_PB_Empty_Buffer_1'(SorA)). flush_output :- set_bip_name(flush_output, 0), '$call_c'('Pl_Flush_Output_0'). flush_output(SorA) :- set_bip_name(flush_output, 1), '$call_c'('Pl_Flush_Output_1'(SorA)). current_stream(Stream) :- set_bip_name(current_stream, 1), '$check_stream_or_var'(Stream, S), '$current_stream'(S). '$current_stream'(S) :- '$call_c_test'('Pl_Current_Stream_1'(S)). '$current_stream_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Stream_Alt_0'). stream_property(Stream, Property) :- set_bip_name(stream_property, 2), '$check_stream_or_var'(Stream, S), ( nonvar(Property), Property = alias(Alias), atom(Alias) -> '$call_c_test'('Pl_From_Alias_To_Stream_2'(Alias, S)) ; '$check_stream_prop'(Property), !, '$current_stream'(S), '$stream_property1'(Property, S) ). '$check_stream_prop'(Property) :- var(Property). '$check_stream_prop'(file_name(_)). '$check_stream_prop'(mode(_)). '$check_stream_prop'(input). '$check_stream_prop'(output). '$check_stream_prop'(alias(_)). '$check_stream_prop'(mirror(_)). '$check_stream_prop'(type(_)). '$check_stream_prop'(reposition(_)). '$check_stream_prop'(eof_action(_)). '$check_stream_prop'(buffering(_)). '$check_stream_prop'(end_of_stream(_)). '$check_stream_prop'(position(_)). '$check_stream_prop'(Property) :- '$pl_err_domain'(stream_property, Property). '$stream_property1'(file_name(File), S) :- '$call_c_test'('Pl_Stream_Prop_File_Name_2'(File, S)). '$stream_property1'(mode(Mode), S) :- '$call_c_test'('Pl_Stream_Prop_Mode_2'(Mode, S)). '$stream_property1'(input, S) :- '$call_c_test'('Pl_Stream_Prop_Input_1'(S)). '$stream_property1'(output, S) :- '$call_c_test'('Pl_Stream_Prop_Output_1'(S)). '$stream_property1'(alias(Alias), S) :- '$current_alias'(S, Alias). '$stream_property1'(mirror(MS), S) :- '$current_mirror'(S, MStm), MS = '$stream'(MStm). '$stream_property1'(type(Type), S) :- '$call_c_test'('Pl_Stream_Prop_Type_2'(Type, S)). '$stream_property1'(reposition(Reposition), S) :- '$call_c_test'('Pl_Stream_Prop_Reposition_2'(Reposition, S)). '$stream_property1'(eof_action(EofAction), S) :- '$call_c_test'('Pl_Stream_Prop_Eof_Action_2'(EofAction, S)). '$stream_property1'(buffering(Buffering), S) :- '$call_c_test'('Pl_Stream_Prop_Buffering_2'(Buffering, S)). '$stream_property1'(position(Position), S) :- '$stream_position'('$stream'(S), Position). '$stream_property1'(end_of_stream(EndOfStream), S) :- '$call_c_test'('Pl_Stream_Prop_End_Of_Stream_2'(EndOfStream, S)). at_end_of_stream :- set_bip_name(at_end_of_stream, 0), '$call_c_test'('Pl_At_End_Of_Stream_0'). at_end_of_stream(SorA) :- set_bip_name(at_end_of_stream, 1), '$call_c_test'('Pl_At_End_Of_Stream_1'(SorA)). current_alias(Stream, Alias) :- set_bip_name(current_alias, 2), '$check_stream_or_var'(Stream, S), ( atom(Alias) -> '$call_c_test'('Pl_From_Alias_To_Stream_2'(Alias, S)) ; '$current_stream'(S), '$current_alias'(S, Alias) ). '$current_alias'(S, Alias) :- '$call_c_test'('Pl_Current_Alias_2'(S, Alias)). '$current_alias_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Alias_Alt_0'). current_mirror(Stream, MStream) :- set_bip_name(current_mirror, 2), '$check_stream_or_var'(Stream, S), '$check_stream_or_var'(MStream, MStm), '$current_stream'(S), '$current_mirror'(S, MStm). '$current_mirror'(S, MStm) :- '$call_c_test'('Pl_Current_Mirror_2'(S, MStm)). '$current_mirror_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Mirror_Alt_0'). stream_position(SorA, Position) :- set_bip_name(stream_position, 2), '$stream_position'(SorA, Position). '$stream_position'(SorA, Position) :- '$call_c_test'('Pl_Stream_Position_2'(SorA, Position)). set_stream_position(SorA, Position) :- set_bip_name(set_stream_position, 2), '$call_c_test'('Pl_Set_Stream_Position_2'(SorA, Position)). seek(SorA, Whence, Offset, NewLoc) :- set_bip_name(seek, 4), '$call_c_test'('Pl_Seek_4'(SorA, Whence, Offset, NewLoc)). character_count(SorA, Count) :- set_bip_name(character_count, 2), '$call_c_test'('Pl_Character_Count_2'(SorA, Count)). line_count(SorA, Count) :- set_bip_name(line_count, 2), '$call_c_test'('Pl_Line_Count_2'(SorA, Count)). line_position(SorA, Count) :- set_bip_name(line_position, 2), '$call_c_test'('Pl_Line_Position_2'(SorA, Count)). stream_line_column(SorA, Line, Col) :- set_bip_name(stream_line_column, 3), '$call_c_test'('Pl_Stream_Line_Column_3'(SorA, Line, Col)). set_stream_line_column(SorA, Line, Col) :- set_bip_name(set_stream_line_column, 3), '$call_c_test'('Pl_Set_Stream_Line_Column_3'(SorA, Line, Col)). % term_stream operations % term type (open_[input/output]_xxxx_stream/2) in sys_var[0]: % 1=atom, 2=chars, 3=codes open_input_atom_stream(SinkAtom, Stream) :- set_bip_name(open_input_atom_stream, 2), '$get_open_stm'(Stream, Stm), '$sys_var_write'(0, 1), '$call_c'('Pl_Open_Input_Term_Stream_2'(SinkAtom, Stm)). open_input_chars_stream(SinkChars, Stream) :- set_bip_name(open_input_chars_stream, 2), '$get_open_stm'(Stream, Stm), '$sys_var_write'(0, 2), '$call_c'('Pl_Open_Input_Term_Stream_2'(SinkChars, Stm)). open_input_codes_stream(SinkCodes, Stream) :- set_bip_name(open_input_codes_stream, 2), '$get_open_stm'(Stream, Stm), '$sys_var_write'(0, 3), '$call_c'('Pl_Open_Input_Term_Stream_2'(SinkCodes, Stm)). close_input_atom_stream(SorA) :- set_bip_name(close_input_atom_stream, 1), '$sys_var_write'(0, 1), '$call_c'('Pl_Close_Input_Term_Stream_1'(SorA)). close_input_chars_stream(SorA) :- set_bip_name(close_input_chars_stream, 1), '$sys_var_write'(0, 2), '$call_c'('Pl_Close_Input_Term_Stream_1'(SorA)). close_input_codes_stream(SorA) :- set_bip_name(close_input_codes_stream, 1), '$sys_var_write'(0, 3), '$call_c'('Pl_Close_Input_Term_Stream_1'(SorA)). open_output_atom_stream(Stream) :- set_bip_name(open_output_atom_stream, 1), '$get_open_stm'(Stream, Stm), '$sys_var_write'(0, 1), '$call_c'('Pl_Open_Output_Term_Stream_1'(Stm)). open_output_chars_stream(Stream) :- set_bip_name(open_output_chars_stream, 1), '$get_open_stm'(Stream, Stm), '$sys_var_write'(0, 2), '$call_c'('Pl_Open_Output_Term_Stream_1'(Stm)). open_output_codes_stream(Stream) :- set_bip_name(open_output_codes_stream, 1), '$get_open_stm'(Stream, Stm), '$sys_var_write'(0, 3), '$call_c'('Pl_Open_Output_Term_Stream_1'(Stm)). close_output_atom_stream(SorA, SinkAtom) :- set_bip_name(close_output_atom_stream, 2), '$sys_var_write'(0, 1), '$call_c_test'('Pl_Close_Output_Term_Stream_2'(SorA, SinkAtom)). close_output_chars_stream(SorA, SinkChars) :- set_bip_name(close_output_chars_stream, 2), '$sys_var_write'(0, 2), '$call_c_test'('Pl_Close_Output_Term_Stream_2'(SorA, SinkChars)). close_output_codes_stream(SorA, SinkCodes) :- set_bip_name(close_output_codes_stream, 2), '$sys_var_write'(0, 3), '$call_c_test'('Pl_Close_Output_Term_Stream_2'(SorA, SinkCodes)). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/format_c.c�����������������������������������������������������������������0000644�0001750�0001750�00000035367�13021324543�015253� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : format_c.c * * Descr.: formatted output management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #include <stdio.h> #include <stdlib.h> #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Format(StmInf *pstm, char *format, WamWord *lst_adr); static WamWord Read_Arg(WamWord **lst_adr); static char *Arg_Atom(WamWord **lst_adr); static PlLong Arg_Integer(WamWord **lst_adr); static double Arg_Float(WamWord **lst_adr); /*-------------------------------------------------------------------------* * PL_FORMAT_3 * * * *-------------------------------------------------------------------------*/ void Pl_Format_3(WamWord sora_word, WamWord format_word, WamWord args_word) { WamWord word, tag_mask; int stm; StmInf *pstm; char *str; char buff[2048]; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pstm = pl_stm_tbl[stm]; pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); DEREF(format_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK && word != NIL_WORD) str = pl_atom_tbl[UnTag_ATM(word)].name; else { strcpy(buff, Pl_Rd_Codes_Check(format_word)); str = buff; } Format(pstm, str, &args_word); } /*-------------------------------------------------------------------------* * PL_FORMAT_2 * * * *-------------------------------------------------------------------------*/ void Pl_Format_2(WamWord format_word, WamWord args_word) { Pl_Format_3(NOT_A_WAM_WORD, format_word, args_word); } /*-------------------------------------------------------------------------* * FORMAT * * * *-------------------------------------------------------------------------*/ static void Format(StmInf *pstm, char *format, WamWord *lst_adr) #define IMPOSS -12345678 { WamWord word; Bool has_n; PlLong generic; PlLong n, n1; char *p; PlLong x; double d; int lg, stop; int i, k; char *format_stack[256]; char **top_stack; char buff[2048]; // printf("d: %p\n", &d); top_stack = format_stack; *top_stack++ = format; do { format = *--top_stack; while (*format) { if (*format == '%') /* C printf format */ { if (format[1] == '%') { Pl_Stream_Putc('%', pstm); format += 2; continue; } p = buff; n = n1 = IMPOSS; do if ((*p++ = *format++) == '*') { if (n == IMPOSS) n = Arg_Integer(&lst_adr); else n1 = Arg_Integer(&lst_adr); } while ((char *) strchr("diouxXpnceEfgGs", p[-1]) == NULL); *p = '\0'; if (strchr("eEfgG", p[-1]) == NULL) { generic = (p[-1] == 's') ? (PlLong) Arg_Atom(&lst_adr) : Arg_Integer(&lst_adr); if (n != IMPOSS) { if (n1 != IMPOSS) Pl_Stream_Printf(pstm, buff, n, n1, generic); else Pl_Stream_Printf(pstm, buff, n, generic); } else Pl_Stream_Printf(pstm, buff, generic); } else { d = Arg_Float(&lst_adr); if (n != IMPOSS) { if (n1 != IMPOSS) Pl_Stream_Printf(pstm, buff, n, n1, d); else Pl_Stream_Printf(pstm, buff, n, d); } else Pl_Stream_Printf(pstm, buff, d); } continue; } if (*format != '~') { Pl_Stream_Putc(*format, pstm); format++; continue; } if (*++format == '*') { n = Arg_Integer(&lst_adr); format++; has_n = TRUE; } else { p = format; n = strtol(format, &format, 10); has_n = (format != p); } switch (*format) { case 'a': p = Arg_Atom(&lst_adr); if (has_n) Pl_Stream_Printf(pstm, "%*s", -n, p); else Pl_Stream_Puts(p, pstm); break; case 'c': x = Arg_Integer(&lst_adr); if (!Is_Valid_Code(x)) Pl_Err_Representation(pl_representation_character_code); do Pl_Stream_Putc(x, pstm); while (--n > 0); break; case 'e': case 'E': case 'f': case 'g': case 'G': x = *format; d = Arg_Float(&lst_adr); if (has_n) sprintf(buff, "%%.%" PL_FMT_d "%c", n, (char) x); else sprintf(buff, "%%%c", (char) x); Pl_Stream_Printf(pstm, buff, d); break; case 'd': case 'D': x = Arg_Integer(&lst_adr); if (n == 0 && *format == 'd') { Pl_Stream_Printf(pstm, "%" PL_FMT_d, x); break; } if (x < 0) { Pl_Stream_Putc('-', pstm); x = -x; } sprintf(buff, "%" PL_FMT_d, x); lg = strlen(buff) - n; if (lg <= 0) { Pl_Stream_Puts("0.", pstm); for (i = 0; i < -lg; i++) Pl_Stream_Putc('0', pstm); Pl_Stream_Printf(pstm, "%" PL_FMT_d, x); break; } stop = (*format == 'D') ? lg % 3 : -1; if (stop == 0) stop = 3; for (p = buff, i = 0; *p; p++, i++) { if (i == lg) Pl_Stream_Putc('.', pstm), stop = -1; if (i == stop) Pl_Stream_Putc(',', pstm), stop += 3; Pl_Stream_Putc(*p, pstm); } break; case 'r': case 'R': x = Arg_Integer(&lst_adr); if (!has_n || n < 2 || n > 36) n = 8; k = ((*format == 'r') ? 'a' : 'A') - 10; if (x < 0) { Pl_Stream_Putc('-', pstm); x = -x; } p = buff + sizeof(buff) - 1; *p = '\0'; do { i = x % n; x = x / n; --p; *p = (i < 10) ? i + '0' : i + k; } while (x); Pl_Stream_Puts(p, pstm); break; case 's': case 'S': word = Read_Arg(&lst_adr); if (*format == 's') p = Pl_Rd_Codes_Check(word); else p = Pl_Rd_Chars_Check(word); if (has_n) Pl_Stream_Printf(pstm, "%-*.*s", n, n, p); else Pl_Stream_Printf(pstm, "%s", p); break; case 'i': do Read_Arg(&lst_adr); while (--n > 0); break; case 'k': word = Read_Arg(&lst_adr); Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_IGNORE_OP | WRITE_QUOTED, NULL, word); break; case 'q': word = Read_Arg(&lst_adr); Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_QUOTED, NULL, word); break; case 'p': /* only work if print.pl is linked */ word = Read_Arg(&lst_adr); Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_PORTRAYED, NULL, word); break; case 'w': word = Read_Arg(&lst_adr); Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS, NULL, word); break; case '~': Pl_Stream_Putc('~', pstm); break; case 'N': if (pstm->line_pos == 0) break; case 'n': do Pl_Stream_Putc('\n', pstm); while (--n > 0); break; case '?': if (format[1]) *top_stack++ = format + 1; format = Arg_Atom(&lst_adr); continue; default: Pl_Err_Domain(pl_domain_format_control_sequence, Tag_ATM(ATOM_CHAR(*format))); } format++; } } while (top_stack > format_stack); } /*-------------------------------------------------------------------------* * READ_ARG * * * *-------------------------------------------------------------------------*/ static WamWord Read_Arg(WamWord **lst_adr) { WamWord word, tag_mask; WamWord *adr; WamWord car_word; DEREF(**lst_adr, word, tag_mask); if (tag_mask != TAG_LST_MASK) { if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) Pl_Err_Domain(pl_domain_non_empty_list, word); Pl_Err_Type(pl_type_list, word); } adr = UnTag_LST(word); car_word = Car(adr); *lst_adr = &Cdr(adr); DEREF(car_word, word, tag_mask); return word; } /*-------------------------------------------------------------------------* * ARG_ATOM * * * *-------------------------------------------------------------------------*/ static char * Arg_Atom(WamWord **lst_adr) { WamWord word; word = Read_Arg(lst_adr); return pl_atom_tbl[Pl_Rd_Atom_Check(word)].name; } /*-------------------------------------------------------------------------* * ARG_INTEGER * * * *-------------------------------------------------------------------------*/ static PlLong Arg_Integer(WamWord **lst_adr) { WamWord word; word = Read_Arg(lst_adr); Pl_Math_Load_Value(word, &word); return Pl_Rd_Integer_Check(word); } /*-------------------------------------------------------------------------* * ARG_FLOAT * * * *-------------------------------------------------------------------------*/ static double Arg_Float(WamWord **lst_adr) { WamWord word; word = Read_Arg(lst_adr); Pl_Math_Load_Value(word, &word); return Pl_Rd_Number_Check(word); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/term_inl.wam���������������������������������������������������������������0000644�0001750�0001750�00000007241�13021356407�015626� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : term_inl.pl file_name('/home/diaz/GP/src/BipsPl/term_inl.pl'). predicate(system:'$use_term_inl'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:compare/3,44,static,private,monofile,built_in,[ call_c('Pl_Blt_Compare',[fast_call,boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:(==)/2,48,static,private,monofile,built_in,[ call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(\==)/2,51,static,private,monofile,built_in,[ call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(@<)/2,54,static,private,monofile,built_in,[ call_c('Pl_Blt_Term_Lt',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(@=<)/2,57,static,private,monofile,built_in,[ call_c('Pl_Blt_Term_Lte',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(@>)/2,60,static,private,monofile,built_in,[ call_c('Pl_Blt_Term_Gt',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(@>=)/2,63,static,private,monofile,built_in,[ call_c('Pl_Blt_Term_Gte',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:arg/3,69,static,private,monofile,built_in,[ call_c('Pl_Blt_Arg',[fast_call,boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:functor/3,75,static,private,monofile,built_in,[ call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:(=..)/2,81,static,private,monofile,built_in,[ call_c('Pl_Blt_Univ',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:copy_term/2,87,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[copy_term,2]), call_c('Pl_Copy_Term_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:setarg/3,94,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[setarg,3]), put_atom(true,3), call_c('Pl_Setarg_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:setarg/4,99,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[setarg,4]), call_c('Pl_Setarg_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:term_ref/2,106,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[term_ref,2]), call_c('Pl_Term_Ref_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:term_variables/2,112,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[term_variables,2]), call_c('Pl_Term_Variables_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:term_variables/3,117,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[term_variables,3]), call_c('Pl_Term_Variables_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:subsumes_term/2,123,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[subsumes_term,2]), call_c('Pl_Subsumes_Term_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:acyclic_term/1,129,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[acyclic_term,1]), call_c('Pl_Acyclic_Term_1',[boolean],[x(0)]), proceed]). predicate(system:term_hash/4,135,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[term_hash,4]), call_c('Pl_Term_Hash_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:term_hash/2,139,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[term_hash,2]), call_c('Pl_Term_Hash_2',[boolean],[x(0),x(1)]), proceed]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/foreign_supp.h�������������������������������������������������������������0000644�0001750�0001750�00000016234�13021324543�016156� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : foreign_supp.h * * Descr.: foreign interface support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define PL_RECOVER 0 #define PL_CUT 1 #define PL_KEEP_FOR_PROLOG 2 #define PL_FAILURE FALSE #define PL_SUCCESS TRUE #define PL_EXCEPTION 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef WamWord PlTerm; typedef enum { PL_FALSE, PL_TRUE} PlBool; typedef struct { Bool is_var; Bool unify; union { PlLong l; char *s; double d; } value; } PlFIOArg; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef FOREIGN_SUPP_FILE int pl_foreign_bkt_counter; char *pl_foreign_bkt_buffer; #else extern int pl_foreign_bkt_counter; extern char *pl_foreign_bkt_buffer; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Foreign_Create_Choice(CodePtr codep_alt, int arity, int choice_size); void Pl_Foreign_Update_Choice(CodePtr codep_alt, int arity, int choice_size); CodePtr Pl_Foreign_Jump_Ret(CodePtr codep); PlFIOArg *Pl_Foreign_Rd_IO_Arg(int arg_long, WamWord start_word, PlLong (*rd_fct) (), int fio_arg_index); Bool Pl_Foreign_Un_IO_Arg(int arg_long, Bool (*un_fct) (), PlFIOArg *fa, WamWord start_word); void Pl_Emit_Syntax_Error(char *file_name, int err_line, int err_col, char *err_msg); void Pl_Exec_Continuation(int func, int arity, WamWord *arg_adr); void Pl_Exec_Continuation_Module(int module, int func, int arity, WamWord *arg_adr); void Pl_Throw(WamWord ball_word); void Pl_Query_Begin(Bool recoverable); int Pl_Query_Call(int func, int arity, WamWord *arg_adr); int Pl_Query_Call_Module(int module, int func, int arity, WamWord *arg_adr); int Pl_Query_Start(int func, int arity, WamWord *arg_adr, Bool recoverable); int Pl_Query_Start_Module(int module, int func, int arity, WamWord *arg_adr, Bool recoverable); int Pl_Query_Next_Solution(void); void Pl_Query_End(int op); WamWord Pl_Get_Exception(void); #define Pl_Get_Choice_Counter() pl_foreign_bkt_counter #define Pl_Get_Choice_Buffer(t) ((t) pl_foreign_bkt_buffer) void Pl_No_More_Choice(void); int Pl_Type_Of_Term(WamWord start_word); char *Pl_Atom_Name(int atom); int Pl_Atom_Length(int atom); Bool Pl_Atom_Needs_Quote(int atom); Bool Pl_Atom_Needs_Scan(int atom); Bool Pl_Is_Valid_Atom(int atom); int Pl_Atom_Char(char c); int Pl_Atom_Nil(void); int Pl_Atom_False(void); int Pl_Atom_True(void); int Pl_Atom_End_Of_File(void); PlBool Pl_Unif(PlTerm term1, PlTerm term2); PlBool Pl_Unif_With_Occurs_Check(PlTerm term1, PlTerm term2); Bool Pl_Builtin_Var(WamWord term); Bool Pl_Builtin_Non_Var(WamWord term); Bool Pl_Builtin_Atom(WamWord term); Bool Pl_Builtin_Integer(WamWord term); Bool Pl_Builtin_Float(WamWord term); Bool Pl_Builtin_Number(WamWord term); Bool Pl_Builtin_Atomic(WamWord term); Bool Pl_Builtin_Compound(WamWord term); Bool Pl_Builtin_Callable(WamWord term); Bool Pl_Builtin_Fd_Var(WamWord term); Bool Pl_Builtin_Non_Fd_Var(WamWord term); Bool Pl_Builtin_Generic_Var(WamWord term); Bool Pl_Builtin_Non_Generic_Var(WamWord term); Bool Pl_Builtin_List(WamWord term); Bool Pl_Builtin_Partial_List(WamWord term); Bool Pl_Builtin_List_Or_Partial_List(WamWord term); Bool Pl_Builtin_Term_Eq(WamWord term1, WamWord term2); Bool Pl_Builtin_Term_Neq(WamWord term1, WamWord term2); Bool Pl_Builtin_Term_Lt(WamWord term1, WamWord term2); Bool Pl_Builtin_Term_Lte(WamWord term1, WamWord term2); Bool Pl_Builtin_Term_Gt(WamWord term1, WamWord term2); Bool Pl_Builtin_Term_Gte(WamWord term1, WamWord term2); Bool Pl_Builtin_Compare(WamWord cmp, WamWord term1, WamWord term2); Bool Pl_Builtin_Arg(WamWord arg_no, WamWord term, WamWord sub_term); Bool Pl_Builtin_Functor(WamWord term, WamWord functor, WamWord arity); Bool Pl_Builtin_Univ(WamWord term, WamWord list); Bool Pl_Builtin_Eq(WamWord expr1, WamWord expr2); Bool Pl_Builtin_Neq(WamWord expr1, WamWord expr2); Bool Pl_Builtin_Lt(WamWord expr1, WamWord expr2); Bool Pl_Builtin_Lte(WamWord expr1, WamWord expr2); Bool Pl_Builtin_Gt(WamWord expr1, WamWord expr2); Bool Pl_Builtin_Gte(WamWord expr1, WamWord expr2); void Pl_Math_Evaluate(WamWord expr, WamWord *result); #define PLV REF #define Stream_Pointer(s) (pl_stm_tbl + (s)) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/throw_c.c������������������������������������������������������������������0000644�0001750�0001750�00000010505�13021324543�015111� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : throw_c.c * * Descr.: exception management (throw) - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ WamWord *pl_query_top_b; /* overwritten by foreign_supp if present */ WamWord pl_query_exception; /* overwritten by foreign_supp if present */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_THROW_2 * * * *-------------------------------------------------------------------------*/ void Pl_Throw_2(WamWord ball_word, WamWord b_word) { WamWord word, tag_mask; WamWord *b; StmInf *pstm; DEREF(b_word, word, tag_mask); b = From_WamWord_To_B(word); if (b <= pl_query_top_b && pl_query_top_b != NULL) { Assign_B(pl_query_top_b); pl_query_exception = ball_word; Pl_Exit_With_Exception(); } if (b == LSSA) { pstm = pl_stm_tbl[pl_stm_top_level_output]; Pl_Stream_Printf(pstm, "\nsystem_error(cannot_catch_throw("); Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_QUOTED, NULL, ball_word); Pl_Stream_Printf(pstm, "))\n"); return; } Pl_Cut(b_word); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/sort_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000022635�13021324543�014744� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : sort_c.c * * Descr.: sort management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define OBJ_INIT Sort_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord minus_2; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static PlLong Keysort_Cmp(WamWord u_word, WamWord v_word); static int Merge_Sort(WamWord *base, WamWord *aux, int n, Bool keep_dup, PlLong (*cmp) ()); /*-------------------------------------------------------------------------* * SORT_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Sort_Initializer(void) { minus_2 = Functor_Arity(ATOM_CHAR('-'), 2); } /*-------------------------------------------------------------------------* * CHK_PAIR * * * *-------------------------------------------------------------------------*/ static void Chk_Pair(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && (tag_mask != TAG_STC_MASK || Functor_And_Arity(UnTag_STC(word)) != minus_2)) Pl_Err_Type(pl_type_pair, word); } /*-------------------------------------------------------------------------* * GET_PAIR * * * *-------------------------------------------------------------------------*/ static WamWord Get_Pair(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_STC_MASK || Functor_And_Arity(UnTag_STC(word)) != minus_2) Pl_Err_Type(pl_type_pair, word); return word; /* store dereferenced words in the array */ } /*-------------------------------------------------------------------------* * PL_SORT_LIST_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sort_List_2(WamWord list1_word, WamWord list2_word) { WamWord *arg; int n; int sort_type; sort_type = SYS_VAR_OPTION_MASK; /* 0=sort/2, 1=msort/2, 2=keysort/2 */ arg = H; /* array in the heap */ if (sort_type != 2) { Pl_Check_For_Un_List(list2_word); n = Pl_Rd_Proper_List_Check(list1_word, arg); } else { Pl_Check_For_Un_List2(list2_word, Chk_Pair); n = Pl_Rd_Proper_List_Check2(list1_word, arg, Get_Pair); } if (n == 0) return Pl_Un_Atom(ATOM_NIL, list2_word); if (n == 1) return Pl_Unify(list1_word, list2_word); n = Merge_Sort(arg, arg + n, n, sort_type, (sort_type != 2) ? Pl_Term_Compare : Keysort_Cmp); /* n can have changed here (if dup removed) */ return Pl_Unify(Pl_Mk_Proper_List(n, arg), list2_word); } /*-------------------------------------------------------------------------* * PL_SORT_LIST_1 * * * *-------------------------------------------------------------------------*/ void Pl_Sort_List_1(WamWord list_word) { WamWord word, tag_mask; WamWord *adr, *arg, *prev; int n; int sort_type; sort_type = SYS_VAR_OPTION_MASK; /* 0=sort/1, 1=msort/1, 2=keysort/1 */ arg = H; if (sort_type != 2) { n = Pl_Rd_Proper_List_Check(list_word, arg); } else { n = Pl_Rd_Proper_List_Check2(list_word, arg, Get_Pair); } if (n <= 1) return; n = Merge_Sort(arg, arg + n, n, sort_type, (sort_type != 2) ? Pl_Term_Compare : Keysort_Cmp); /* n can have changed here (if dup removed) */ /* update in-place the list */ do { DEREF(list_word, word, tag_mask); adr = UnTag_LST(word); Car(adr) = *arg++; prev = &Cdr(adr); list_word = Cdr(adr); } while (--n); *prev = NIL_WORD; } /*-------------------------------------------------------------------------* * KEYSORT_CMP * * * *-------------------------------------------------------------------------*/ static PlLong Keysort_Cmp(WamWord u_word, WamWord v_word) { /* here we know that u_word and v_word are dereferenced (and are pairs) */ u_word = Arg(UnTag_STC(u_word), 0); v_word = Arg(UnTag_STC(v_word), 0); return Pl_Term_Compare(u_word, v_word); } /*-------------------------------------------------------------------------* * MERGE_SORT * * * * Merge sort on an array on n WamWords starting at base using an auxiliary* * array for the merge at aux. The comparaison function cmp will receive 2 * * elements of the array (2 WamWords) and classically returns <0, 0, >0. * *-------------------------------------------------------------------------*/ static int Merge_Sort(WamWord *base, WamWord *aux, int n, Bool keep_dup, PlLong (*cmp) ()) { WamWord *l1, *l2; int n1, n2; WamWord *p; if (n <= 1) return n; n1 = n / 2; n2 = n - n1; l1 = base; l2 = base + n1; n1 = Merge_Sort(l1, aux, n1, keep_dup, cmp); n2 = Merge_Sort(l2, aux, n2, keep_dup, cmp); n = n1 + n2; p = aux; while (n1 > 0 && n2 > 0) { if ((*cmp) (*l1, *l2) <= 0) /* copy smaller element to aux */ { *p++ = *l1++; n1--; } else { *p++ = *l2++; n2--; } } while (n1-- > 0) /* copy n1 elements to aux */ *p++ = *l1++; if (keep_dup) { n1 = n - n2; /* there are n2 elements already in place */ p = aux; while (n1-- > 0) /* copy n-n2 elemens to base */ *base++ = *p++; return n; } while (n2-- > 0) /* copy n2 elements to aux (needed for test dup) */ *p++ = *l2++; p = aux; *base = *p++; /* copy 1st element to base (init test dup) */ n1 = n - 1; while (n1-- > 0) /* copy n-1 elemens to base + test dup */ { if (cmp(*base, *p) < 0) *++base = *p++; else { n--; p++; } } return n; } ���������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/oper.pl��������������������������������������������������������������������0000644�0001750�0001750�00000006522�13021324543�014606� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : oper.pl * * Descr.: operator management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_oper'. op(Prec, Specif, Oper) :- set_bip_name(op, 3), '$check_atom_or_atom_list'(Oper), ( atom(Oper) -> '$op2'(Prec, Specif, Oper) ; '$op1'(Oper, Specif, Prec) ). '$op1'([], _, _). '$op1'([Oper|LOper], Specif, Prec) :- '$op2'(Prec, Specif, Oper), '$op1'(LOper, Specif, Prec). '$op2'(Prec, Specif, Oper) :- '$call_c'('Pl_Op_3'(Prec, Specif, Oper)). current_op(Prec, Specif, Oper) :- set_bip_name(current_op, 3), '$call_c_test'('Pl_Current_Op_3'(Prec, Specif, Oper)). '$current_op_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Op_Alt_0'). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/src_rdr.wam����������������������������������������������������������������0000644�0001750�0001750�00000103022�13021356407�015445� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : src_rdr.pl file_name('/home/diaz/GP/src/BipsPl/src_rdr.pl'). predicate(system:'$use_src_rdr'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:sr_open/3,71,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_open,3]), call('$set_sr_defaults'/0), put_value(y(2),0), put_variable(y(3),1), call('$get_sr_options'/2), put_value(y(1),0), call('$sr_open/3_$aux1'/1), put_value(y(1),0), put_unsafe_value(y(3),1), call_c('Pl_SR_Init_Open_2',[],[x(0),x(1)]), put_value(y(0),0), deallocate, execute('$sr_open/3_$aux2'/1)]). predicate(system:'$sr_open/3_$aux2'/1,71,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), get_structure('$stream'/1,0), unify_void(1), cut(x(1)), put_atom(true,1), call_c('Pl_SR_Open_File_2',[],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, execute('$sr_open_new_prolog_file'/1)]). predicate(system:'$sr_open/3_$aux1'/1,71,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, execute('$pl_err_uninstantiation'/1)]). predicate(system:'$set_sr_defaults'/0,104,static,private,monofile,built_in,[ allocate(0), put_integer(0,0), put_integer(1022,1), call('$sys_var_write'/2), put_integer(0,0), put_integer(19,1), call('$sys_var_set_bit'/2), put_integer(1,0), put_integer(0,1), deallocate, execute('$sys_var_write'/2)]). predicate(system:'$get_sr_options'/2,110,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_value(y(0),0), call('$check_list'/1), put_atom('$sr_output_stream',0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), call('$get_sr_options1'/1), put_atom('$sr_output_stream',0), put_value(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed]). predicate(system:'$get_sr_options1'/1,117,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call('$get_sr_options2'/1), cut(y(1)), put_value(y(0),0), deallocate, execute('$get_sr_options1'/1)]). predicate(system:'$get_sr_options2'/1,124,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(2), allocate(3), put_variable(y(0),1), put_integer(1,2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_integer(1,1), put_variable(y(1),2), call_c('Pl_Blt_Arg',[fast_call,boolean],[x(1),x(0),x(2)]), put_value(y(1),0), call('$check_nonvar'/1), put_value(y(0),0), put_void(1), put_variable(y(2),2), call('$sr_treat_pass_no'/3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(y(2),0), put_integer(2,1), call_c('Pl_Fct_Mul',[fast_call,x(1)],[x(0),x(1)]), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(1),0), call_c('Pl_Fct_Inc',[fast_call,x(2)],[x(0)]), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_open,3]), put_unsafe_value(y(1),0), deallocate, execute('$sr_set_treat_pass_bits'/3), label(2), retry_me_else(14), switch_on_term(4,fail,fail,fail,3), label(3), switch_on_structure([(restart/1,5),(reflect_eof/1,7),(undo_directives/1,9),(write_error/1,11),(output_stream/1,13)]), label(4), try_me_else(6), label(5), allocate(1), get_structure(restart/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_sr_options2/1_$aux1'/1), label(6), retry_me_else(8), label(7), allocate(1), get_structure(reflect_eof/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_sr_options2/1_$aux2'/1), label(8), retry_me_else(10), label(9), allocate(1), get_structure(undo_directives/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_sr_options2/1_$aux3'/1), label(10), retry_me_else(12), label(11), allocate(1), get_structure(write_error/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_sr_options2/1_$aux4'/1), label(12), trust_me_else_fail, label(13), allocate(1), get_structure(output_stream/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_atom('$sr_output_stream',0), put_value(y(0),1), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), put_integer(1,0), put_integer(1,1), deallocate, execute('$sys_var_write'/2), label(14), trust_me_else_fail, put_value(x(0),1), put_atom(sr_option,0), execute('$pl_err_domain'/2)]). predicate(system:'$$get_sr_options2/1_$aux4'/1,162,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(19,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(19,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_sr_options2/1_$aux3'/1,154,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(18,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(18,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_sr_options2/1_$aux2'/1,146,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(17,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(17,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_sr_options2/1_$aux1'/1,138,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(16,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(16,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$sr_treat_pass_no'/3,183,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(include,3),(op,5),(set_prolog_flag,7),(char_conversion,9),(module,11),(end_module,13),(body,15),(end_body,17)]), label(2), try_me_else(4), label(3), get_atom(include,0), get_integer(1,1), get_integer(0,2), proceed, label(4), retry_me_else(6), label(5), get_atom(op,0), get_integer(3,1), get_integer(1,2), proceed, label(6), retry_me_else(8), label(7), get_atom(set_prolog_flag,0), get_integer(2,1), get_integer(2,2), proceed, label(8), retry_me_else(10), label(9), get_atom(char_conversion,0), get_integer(2,1), get_integer(3,2), proceed, label(10), retry_me_else(12), label(11), get_atom(module,0), get_integer(1,1), get_integer(4,2), proceed, label(12), retry_me_else(14), label(13), get_atom(end_module,0), get_integer(1,1), get_integer(4,2), proceed, label(14), retry_me_else(16), label(15), get_atom(body,0), get_integer(1,1), get_integer(4,2), proceed, label(16), trust_me_else_fail, label(17), get_atom(end_body,0), get_integer(1,1), get_integer(4,2), proceed]). predicate(system:'$sr_set_treat_pass_bits'/3,195,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(kill,3),(ignore,5),(hide,7),(reflect,9)]), label(2), try_me_else(4), label(3), allocate(1), get_atom(kill,0), get_variable(y(0),2), put_integer(0,0), call('$sys_var_reset_bit'/2), put_integer(0,0), put_value(y(0),1), deallocate, execute('$sys_var_reset_bit'/2), label(4), retry_me_else(6), label(5), allocate(1), get_atom(ignore,0), get_variable(y(0),2), put_integer(0,0), call('$sys_var_set_bit'/2), put_integer(0,0), put_value(y(0),1), deallocate, execute('$sys_var_reset_bit'/2), label(6), retry_me_else(8), label(7), allocate(1), get_atom(hide,0), get_variable(y(0),2), put_integer(0,0), call('$sys_var_reset_bit'/2), put_integer(0,0), put_value(y(0),1), deallocate, execute('$sys_var_set_bit'/2), label(8), trust_me_else_fail, label(9), allocate(1), get_atom(reflect,0), get_variable(y(0),2), put_integer(0,0), call('$sys_var_set_bit'/2), put_integer(0,0), put_value(y(0),1), deallocate, execute('$sys_var_set_bit'/2)]). predicate(system:'$sr_open_new_prolog_file'/1,214,static,private,monofile,built_in,[ put_variable(x(1),2), call_c('Pl_Prolog_File_Name_2',[],[x(0),x(2)]), put_atom(false,0), call_c('Pl_SR_Open_File_2',[],[x(1),x(0)]), proceed]). predicate(system:sr_change_options/2,226,static,private,monofile,built_in,[ allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_change_options,2]), call_c('Pl_SR_Check_Descriptor_1',[],[x(0)]), put_value(x(1),0), call('$get_sr_options1'/1), deallocate, call_c('Pl_SR_Change_Options_0',[],[]), proceed]). predicate(system:sr_close/1,235,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_close,1]), call_c('Pl_SR_Close_1',[],[x(0)]), proceed]). predicate(system:sr_new_pass/1,241,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_new_pass,1]), execute('$sr_new_pass/1_$aux1'/1)]). predicate(system:'$sr_new_pass/1_$aux1'/1,241,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_SR_New_Pass_1',[boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_value(x(0),2), put_atom(new_pass,0), put_atom(one_pass_reader,1), execute('$pl_err_permission'/3)]). predicate(system:sr_read_term/4,251,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_value(y(0),0), call_c('Pl_SR_Check_Descriptor_1',[],[x(0)]), call(repeat/0), put_variable(x(0),1), call_c('Pl_SR_Get_Stm_For_Read_Term_1',[],[x(1)]), put_structure('$stream'/1,1), unify_value(x(0)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_read_term,3]), put_structure('$read_term'/3,0), unify_value(x(1)), unify_local_value(y(1)), unify_local_value(y(2)), put_variable(y(5),1), put_atom(true,2), put_atom(system,3), put_atom(sr_read_term,4), put_integer(3,5), call('$catch'/6), call_c('Pl_SR_Update_Position_0',[],[]), put_value(y(5),0), put_value(y(1),1), put_value(y(3),2), call('$sr_read_term/4_$aux1'/3), put_value(y(3),0), put_value(y(0),1), call('$sr_read_term/4_$aux2'/2), cut(y(4)), deallocate, proceed]). predicate(system:'$sr_read_term/4_$aux2'/2,251,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_variable(x(3),1), get_variable(x(1),0), get_structure(sr_error/2,1), unify_void(2), put_integer(19,0), call_c('Pl_SR_Is_Bit_Set_1',[boolean],[x(0)]), cut(x(2)), put_value(x(3),0), execute(sr_write_error/2), label(1), trust_me_else_fail, proceed]). predicate(system:'$sr_read_term/4_$aux1'/3,251,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), put_value(x(1),0), put_value(x(2),1), execute('$sr_treat_term'/2), label(1), trust_me_else_fail, get_atom('$sr_read_term_error',1), put_value(x(2),1), execute('$sr_error_from_exception'/2)]). predicate(system:'$sr_treat_term'/2,278,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(end_of_file,3), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), put_variable(x(0),2), call_c('Pl_SR_EOF_Reached_1',[boolean],[x(2)]), execute('$$sr_treat_term/2_$aux1'/2), label(1), retry_me_else(2), allocate(6), get_variable(y(0),1), get_variable(y(1),2), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), get_structure((:-)/1,0), unify_variable(y(2)), put_value(y(2),0), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_value(y(2),2), put_variable(x(0),3), put_variable(x(1),4), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(2),x(3),x(4)]), put_variable(y(3),2), call('$sr_treat_pass_no'/3), cut(y(1)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(y(3),0), put_integer(2,1), call_c('Pl_Fct_Mul',[fast_call,x(0)],[x(0),x(1)]), get_variable(y(4),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(y(4),0), call_c('Pl_Fct_Inc',[fast_call,x(0)],[x(0)]), put_value(y(2),1), put_value(y(0),2), put_variable(y(5),3), call('$$sr_treat_term/2_$aux2'/4), put_unsafe_value(y(5),0), put_unsafe_value(y(4),1), deallocate, execute('$$sr_treat_term/2_$aux3'/2), label(2), trust_me_else_fail, get_atom(sr_ok,1), proceed]). predicate(system:'$$sr_treat_term/2_$aux3'/2,286,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), call_c('Pl_SR_Is_Bit_Set_1',[boolean],[x(1)]), proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$$sr_treat_term/2_$aux2'/4,286,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_variable(x(5),2), call_c('Pl_SR_Is_Bit_Set_1',[boolean],[x(0)]), cut(x(4)), put_structure('$sr_exec_directive'/2,0), unify_local_value(x(1)), unify_local_value(x(5)), put_structure('$sr_error_from_exception'/2,2), unify_local_value(x(3)), unify_local_value(x(5)), put_value(x(3),1), put_atom(system,3), put_atom(any,4), put_integer(0,5), execute('$catch'/6), label(1), trust_me_else_fail, proceed]). predicate(system:'$$sr_treat_term/2_$aux1'/2,278,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), get_atom(sr_ok,1), proceed, label(1), trust_me_else_fail, get_structure(sr_error/2,1), unify_atom(warning), unify_local_value(x(0)), proceed]). predicate(system:'$sr_exec_directive'/2,311,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), call('$sr_directive1'/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_structure(sr_error/2,1), unify_atom(warning), unify_atom('directive failed'), proceed]). predicate(system:'$sr_directive1'/2,321,static,private,monofile,built_in,[ switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(include/1,3),(op/3,5),(set_prolog_flag/2,7),(char_conversion/2,9),(module/1,11),(body/1,13),(end_module/1,15),(end_body/1,17)]), label(2), try_me_else(4), label(3), get_atom(sr_ok,1), get_structure(include/1,0), unify_variable(x(0)), execute('$sr_open_new_prolog_file'/1), label(4), retry_me_else(6), label(5), allocate(5), get_structure(op/3,0), unify_variable(y(0)), unify_variable(y(1)), unify_variable(y(2)), get_atom(sr_ok,1), put_value(y(1),0), put_value(y(2),1), put_variable(y(3),2), put_variable(y(4),3), call('$$sr_directive1/2_$aux1'/4), put_integer(0,0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), put_unsafe_value(y(3),4), put_unsafe_value(y(4),5), put_value(y(2),6), deallocate, call_c('Pl_SR_Add_Directive_7',[],[x(0),x(1),x(2),x(3),x(4),x(5),x(6)]), proceed, label(6), retry_me_else(8), label(7), allocate(3), get_structure(set_prolog_flag/2,0), unify_variable(y(0)), unify_variable(y(1)), get_atom(sr_ok,1), put_value(y(0),0), put_variable(y(2),1), call('$$sr_directive1/2_$aux2'/2), put_integer(1,0), put_value(y(0),1), put_value(y(1),2), put_integer(0,3), put_value(y(0),4), put_unsafe_value(y(2),5), put_integer(0,6), deallocate, call_c('Pl_SR_Add_Directive_7',[],[x(0),x(1),x(2),x(3),x(4),x(5),x(6)]), proceed, label(8), retry_me_else(10), label(9), allocate(3), get_structure(char_conversion/2,0), unify_variable(y(0)), unify_variable(y(1)), get_atom(sr_ok,1), put_value(y(0),0), put_variable(y(2),1), call('$$sr_directive1/2_$aux3'/2), put_integer(2,0), put_value(y(0),1), put_value(y(1),2), put_integer(0,3), put_value(y(0),4), put_unsafe_value(y(2),5), put_integer(0,6), deallocate, call_c('Pl_SR_Add_Directive_7',[],[x(0),x(1),x(2),x(3),x(4),x(5),x(6)]), proceed, label(10), retry_me_else(12), label(11), get_structure(module/1,0), unify_variable(x(0)), put_value(x(1),2), put_atom(true,1), execute('$sr_start_module'/3), label(12), retry_me_else(14), label(13), get_structure(body/1,0), unify_variable(x(0)), put_value(x(1),2), put_atom(false,1), execute('$sr_start_module'/3), label(14), retry_me_else(16), label(15), get_structure(end_module/1,0), unify_variable(x(0)), put_value(x(1),2), put_atom(true,1), execute('$sr_stop_module'/3), label(16), trust_me_else_fail, label(17), get_structure(end_body/1,0), unify_variable(x(0)), put_value(x(1),2), put_atom(false,1), execute('$sr_stop_module'/3)]). predicate(system:'$$sr_directive1/2_$aux3'/2,347,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), call(current_char_conversion/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(system:'$$sr_directive1/2_$aux2'/2,338,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), call(current_prolog_flag/2), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$$sr_directive1/2_$aux1'/4,324,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_value(y(0),1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(1)]), put_variable(y(4),1), call('$sr_op_type'/2), put_value(y(1),0), put_value(y(2),1), put_value(y(0),2), call(current_op/3), put_value(y(2),0), put_value(y(4),1), call('$sr_op_type'/2), cut(y(3)), deallocate, proceed, label(1), trust_me_else_fail, get_integer(0,2), get_value(x(0),3), proceed]). predicate(system:'$sr_op_type'/2,371,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(fx,3),(fy,5),(xfx,7),(yfx,9),(xfy,11),(xf,13),(yf,15)]), label(2), try_me_else(4), label(3), get_atom(fx,0), get_atom(prefix,1), proceed, label(4), retry_me_else(6), label(5), get_atom(fy,0), get_atom(prefix,1), proceed, label(6), retry_me_else(8), label(7), get_atom(xfx,0), get_atom(infix,1), proceed, label(8), retry_me_else(10), label(9), get_atom(yfx,0), get_atom(infix,1), proceed, label(10), retry_me_else(12), label(11), get_atom(xfy,0), get_atom(infix,1), proceed, label(12), retry_me_else(14), label(13), get_atom(xf,0), get_atom(postfix,1), proceed, label(14), trust_me_else_fail, label(15), get_atom(yf,0), get_atom(postfix,1), proceed]). predicate(system:'$sr_start_module'/3,382,static,private,monofile,built_in,[ get_variable(x(3),0), put_variable(x(0),4), call_c('Pl_SR_Start_Module_3',[],[x(3),x(1),x(4)]), put_value(x(2),1), execute('$$sr_start_module/3_$aux1'/2)]). predicate(system:'$$sr_start_module/3_$aux1'/2,382,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), get_atom(sr_ok,1), proceed, label(1), trust_me_else_fail, get_structure(sr_error/2,1), unify_atom(warning), unify_local_value(x(0)), proceed]). predicate(system:'$sr_stop_module'/3,391,static,private,monofile,built_in,[ get_variable(x(3),0), put_variable(x(0),4), call_c('Pl_SR_Stop_Module_3',[],[x(3),x(1),x(4)]), put_value(x(2),1), execute('$$sr_stop_module/3_$aux1'/2)]). predicate(system:'$$sr_stop_module/3_$aux1'/2,391,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(2)), get_atom(sr_ok,1), proceed, label(1), trust_me_else_fail, get_structure(sr_error/2,1), unify_atom(warning), unify_local_value(x(0)), proceed]). predicate(system:sr_current_descriptor/1,400,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_current_descriptor,1]), call_c('Pl_SR_Current_Descriptor_1',[boolean],[x(0)]), proceed]). predicate(system:'$sr_current_descriptor_alt'/0,407,static,private,monofile,built_in,[ call_c('Pl_SR_Current_Descriptor_Alt_0',[boolean],[]), proceed]). predicate(system:sr_get_stream/2,413,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_stream,2]), put_value(x(1),0), put_variable(y(1),1), call('$check_stream_or_var'/2), put_value(y(0),0), put_unsafe_value(y(1),1), deallocate, call_c('Pl_SR_Get_Stm_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:sr_get_module/3,421,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_module,3]), call_c('Pl_SR_Get_Module_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:sr_get_file_name/2,428,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_file_name,2]), call_c('Pl_SR_Get_File_Name_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:sr_get_position/3,435,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_position,3]), call_c('Pl_SR_Get_Position_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:sr_get_include_list/2,442,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_include_list,2]), call_c('Pl_SR_Get_Include_List_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:sr_get_include_stream_list/2,449,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_include_stream_list,2]), call_c('Pl_SR_Get_Include_Stream_List_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:sr_get_size_counters/3,456,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_size_counters,3]), call_c('Pl_SR_Get_Size_Counters_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:sr_get_error_counters/3,463,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_get_error_counters,3]), call_c('Pl_SR_Get_Error_Counters_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:sr_set_error_counters/3,470,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_set_error_counters,3]), call_c('Pl_SR_Set_Error_Counters_3',[],[x(0),x(1),x(2)]), proceed]). predicate(system:sr_write_message/4,477,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_write_message,4]), call_c('Pl_SR_Write_Message_4',[],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:sr_write_message/6,484,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_write_message,6]), call_c('Pl_SR_Write_Message_6',[],[x(0),x(1),x(2),x(3),x(4),x(5)]), proceed]). predicate(system:sr_write_message/8,491,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_write_message,8]), call_c('Pl_SR_Write_Message_8',[],[x(0),x(1),x(2),x(3),x(4),x(5),x(6),x(7)]), proceed]). predicate(system:sr_write_error/2,498,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(7), get_variable(y(0),0), get_variable(y(1),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_write_error,2]), put_value(x(1),0), put_variable(y(2),1), put_variable(y(3),2), put_variable(y(4),3), put_variable(y(5),4), put_variable(y(6),5), call('$sr_get_format_args_error'/6), put_value(y(2),0), put_value(y(0),1), put_value(y(4),2), put_value(y(5),3), put_value(y(6),4), put_value(y(3),5), call('$sr_write_error/2_$aux1'/6), cut(y(1)), deallocate, proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$sr_write_error/2_$aux1'/6,498,static,private,monofile,local,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), call_c('Pl_SR_Write_Message_4',[],[x(1),x(2),x(3),x(4)]), proceed, label(1), trust_me_else_fail, call_c('Pl_SR_Write_Message_6',[],[x(1),x(0),x(5),x(2),x(3),x(4)]), proceed]). predicate(system:sr_write_error/4,512,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(9), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),4), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_write_error,4]), put_value(x(3),0), put_variable(y(4),1), put_variable(y(5),2), put_variable(y(6),3), put_variable(y(7),4), put_variable(y(8),5), call('$sr_get_format_args_error'/6), put_value(y(1),0), put_value(y(4),1), put_value(y(2),2), put_value(y(5),3), call('$sr_write_error/4_$aux1'/4), put_value(y(0),0), put_unsafe_value(y(4),1), put_unsafe_value(y(5),2), put_unsafe_value(y(6),3), put_unsafe_value(y(7),4), put_unsafe_value(y(8),5), call_c('Pl_SR_Write_Message_6',[],[x(0),x(1),x(2),x(3),x(4),x(5)]), cut(y(3)), deallocate, proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$sr_write_error/4_$aux1'/4,512,static,private,monofile,local,[ try_me_else(1), get_value(x(1),0), get_value(x(3),2), proceed, label(1), trust_me_else_fail, proceed]). predicate(system:sr_write_error/6,523,static,private,monofile,built_in,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(11), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),6), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_write_error,6]), put_value(x(5),0), put_variable(y(6),1), put_variable(y(7),2), put_variable(y(8),3), put_variable(y(9),4), put_variable(y(10),5), call('$sr_get_format_args_error'/6), put_value(y(3),0), put_value(y(6),1), put_value(y(4),2), put_value(y(7),3), call('$sr_write_error/6_$aux1'/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(6),3), put_unsafe_value(y(7),4), put_unsafe_value(y(8),5), put_unsafe_value(y(9),6), put_unsafe_value(y(10),7), call_c('Pl_SR_Write_Message_8',[],[x(0),x(1),x(2),x(3),x(4),x(5),x(6),x(7)]), cut(y(5)), deallocate, proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$sr_write_error/6_$aux1'/4,523,static,private,monofile,local,[ try_me_else(1), get_value(x(1),0), get_value(x(3),2), proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$sr_get_format_args_error'/6,535,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, get_structure(sr_error/2,0), unify_local_value(x(3)), unify_variable(x(0)), put_value(x(4),3), put_value(x(5),4), execute('$sr_simpl_error'/5)]). predicate(system:'$sr_simpl_error'/5,546,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(8), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(syntax/3,3),(existence_error/2,5),(permission_error/3,7)]), label(2), try_me_else(4), label(3), get_structure(syntax/3,0), unify_local_value(x(1)), unify_variable(x(1)), unify_variable(x(0)), cut(x(5)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(1),1), call_c('Pl_Fct_Neg',[fast_call,x(1)],[x(1)]), get_value(x(2),1), get_atom('~a~n',3), get_list(4), unify_value(x(0)), unify_nil, proceed, label(4), retry_me_else(6), label(5), get_structure(existence_error/2,0), unify_atom(source_sink), unify_variable(x(0)), cut(x(5)), get_atom('cannot open file ~a - does not exist~n',3), get_list(4), unify_value(x(0)), unify_nil, proceed, label(6), trust_me_else_fail, label(7), get_structure(permission_error/3,0), unify_atom(open), unify_atom(source_sink), unify_variable(x(0)), cut(x(5)), get_atom('cannot open file ~a - permission error~n',3), get_list(4), unify_value(x(0)), unify_nil, proceed, label(8), trust_me_else_fail, get_atom('~w~n',3), get_list(4), unify_local_value(x(0)), unify_nil, proceed]). predicate(system:sr_error_from_exception/2,569,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[sr_error_from_exception,2]), put_value(y(0),0), call('$sr_error_from_exception/2_$aux1'/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$sr_error_from_exception'/2)]). predicate(system:'$sr_error_from_exception/2_$aux1'/1,569,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, proceed]). predicate(system:'$sr_error_from_exception'/2,578,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(7), switch_on_term(3,fail,fail,fail,1), label(1), switch_on_structure([(error/2,2)]), label(2), try(4), trust(6), label(3), try_me_else(5), label(4), allocate(4), get_structure(error/2,0), unify_variable(x(0)), unify_void(1), get_structure(syntax_error/1,0), unify_void(1), get_variable(y(0),1), cut(x(2)), put_void(0), put_variable(y(1),1), put_variable(y(2),2), put_variable(y(3),3), call(syntax_error_info/4), put_value(y(0),0), get_structure(sr_error/2,0), unify_atom(error), unify_structure(syntax/3), unify_local_value(y(1)), unify_local_value(y(2)), unify_local_value(y(3)), deallocate, proceed, label(5), trust_me_else_fail, label(6), get_structure(error/2,0), unify_variable(x(0)), unify_void(1), get_structure(sr_error/2,1), unify_atom(error), unify_value(x(0)), cut(x(2)), proceed, label(7), trust_me_else_fail, get_structure(sr_error/2,1), unify_atom(exception), unify_local_value(x(0)), proceed]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stat.pl��������������������������������������������������������������������0000644�0001750�0001750�00000011527�13021324543�014615� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : stat.pl * * Descr.: statistics predicate management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_stat'. statistics :- set_bip_name(statistics, 0), '$call_c'('Pl_Statistics_0'). statistics(Key, Values) :- set_bip_name(statistics, 2), '$check_stat_key'(Key), !, ( Values = [Val1, Val2] -> true ; '$pl_err_domain'(statistics_value, Values) ), '$stat'(Key, Val1, Val2). '$check_stat_key'(Key) :- var(Key). '$check_stat_key'(user_time). '$check_stat_key'(runtime). '$check_stat_key'(system_time). '$check_stat_key'(cpu_time). '$check_stat_key'(real_time). '$check_stat_key'(local_stack). '$check_stat_key'(global_stack). '$check_stat_key'(trail_stack). '$check_stat_key'(cstr_stack). '$check_stat_key'(atoms). '$check_stat_key'(Key) :- '$pl_err_domain'(statistics_key, Key). '$stat'(X, SinceStart, SinceLast) :- ( atom(X) -> ( X = user_time ; X = runtime ), ! ; X = user_time ), '$call_c_test'('Pl_Statistics_User_Time_2'(SinceStart, SinceLast)). '$stat'(system_time, SinceStart, SinceLast) :- '$call_c_test'('Pl_Statistics_System_Time_2'(SinceStart, SinceLast)). '$stat'(cpu_time, SinceStart, SinceLast) :- '$call_c_test'('Pl_Statistics_Cpu_Time_2'(SinceStart, SinceLast)). '$stat'(real_time, SinceStart, SinceLast) :- '$call_c_test'('Pl_Statistics_Real_Time_2'(SinceStart, SinceLast)). '$stat'(local_stack, Used, Free) :- '$call_c_test'('Pl_Statistics_Local_Stack_2'(Used, Free)). '$stat'(global_stack, Used, Free) :- '$call_c_test'('Pl_Statistics_Global_Stack_2'(Used, Free)). '$stat'(trail_stack, Used, Free) :- '$call_c_test'('Pl_Statistics_Trail_Stack_2'(Used, Free)). '$stat'(cstr_stack, Used, Free) :- '$call_c_test'('Pl_Statistics_Cstr_Stack_2'(Used, Free)). '$stat'(atoms, Used, Free) :- '$call_c_test'('Pl_Statistics_Atoms_2'(Used, Free)). user_time(SinceStart) :- set_bip_name(user_time, 1), '$call_c_test'('Pl_User_Time_1'(SinceStart)). system_time(SinceStart) :- set_bip_name(system_time, 1), '$call_c_test'('Pl_System_Time_1'(SinceStart)). cpu_time(SinceStart) :- set_bip_name(cpu_time, 1), '$call_c_test'('Pl_Cpu_Time_1'(SinceStart)). real_time(SinceStart) :- set_bip_name(real_time, 1), '$call_c_test'('Pl_Real_Time_1'(SinceStart)). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stream_supp.h��������������������������������������������������������������0000644�0001750�0001750�00000031365�13021324543�016022� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : stream_supp.h * * Descr.: stream support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> /*---------------------------------* * Constants * *---------------------------------*/ #define STREAM_PB_SIZE 8 /* push back buffer size */ #define STREAM_MODE_READ 0 #define STREAM_MODE_WRITE 1 #define STREAM_MODE_APPEND 2 #define STREAM_EOF_ACTION_ERROR 0 #define STREAM_EOF_ACTION_EOF_CODE 1 #define STREAM_EOF_ACTION_RESET 2 #define STREAM_BUFFERING_NONE 0 #define STREAM_BUFFERING_LINE 1 #define STREAM_BUFFERING_BLOCK 2 #define STREAM_EOF_NOT 0 #define STREAM_EOF_AT 1 #define STREAM_EOF_PAST 2 /* values for Get_Stream_Or_Alias */ #define STREAM_CHECK_VALID 0 /* simply a valid stream */ #define STREAM_CHECK_EXIST 1 /* valid and exist */ #define STREAM_CHECK_INPUT 2 /* valid, exist and mode=input */ #define STREAM_CHECK_OUTPUT 3 /* valid, exist and mode=output */ #define STREAM_FCT_UNDEFINED ((StmFct) (-1)) /* for optional fct */ /* Constant term streams (prop.other) */ #define TERM_STREAM_ATOM 1 /* values also used in stream.pl */ #define TERM_STREAM_CHARS 2 #define TERM_STREAM_CODES 3 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct /* Stream properties */ { /* ------------------------------ */ unsigned mode:2; /* see STREAM_MODE_xxx defs */ unsigned input:1; /* is it an input stream ? */ unsigned output:1; /* is it an output stream ? */ unsigned text:1; /* is it a text stream . (or bin) */ unsigned reposition:1; /* can it be repositioned ? */ unsigned eof_action:2; /* see STREAM_EOF_ACTION_xxx defs */ unsigned buffering:2; /* see STREAM_BUFFERING_xxx defs */ unsigned special_close:1; /* does it need a special close ? */ unsigned other:8; /* other prop (1,2,3=term_streams */ } /* 4=socket_stream) */ StmProp; typedef struct /* Push Back stack */ { /* ------------------------------ */ int buff[STREAM_PB_SIZE]; /* the buffer */ int *ptr; /* pointer into the buffer */ int nb_elems; /* # of elements in the buffer */ } PbStk; typedef int (*StmFct) (); /* generic type for file fctions */ typedef struct stm_lst *PStmLst; typedef struct stm_lst /* Chained stream list */ { /* ------------------------------ */ int stm; /* the stream */ PStmLst next; /* next entry */ } StmLst; typedef struct stm_inf /* Stream information */ { /* ------------------------------ */ int atom_file_name; /* atom associated to filename */ PlLong file; /* accessor (FILE *,TTYInf *) != 0*/ StmProp prop; /* assoctiated properties */ StmLst *mirror; /* mirror streams */ StmLst *mirror_of; /* streams this stream as mirror */ /* ----- Basic I/O functions ---- */ StmFct fct_getc; /* get char function (mandatory) */ StmFct fct_putc; /* put char function (mandatory) */ StmFct fct_flush; /* flush function (optional) */ StmFct fct_close; /* close function (optional) */ StmFct fct_tell; /* tell function (optional) */ StmFct fct_seek; /* seek function (optional) */ StmFct fct_clearerr; /* clearerr function (optional) */ /* ------ Read information ----- */ Bool eof_reached; /* has eof char been read ? */ PbStk pb_char; /* character push back stack */ /* ---- Position information --- */ PlLong char_count; /* character read count */ PlLong line_count; /* line read count */ PlLong line_pos; /* line position */ PbStk pb_line_pos; /* line position push back stack */ } StmInf; typedef struct /* Alias information */ { /* ------------------------------ */ PlLong atom; /* atom of the alias (the key) */ int stm; /* associated stream */ } AliasInf; typedef struct /* String Stream information */ { /* ------------------------------ */ char *buff; /* the I/O buffer */ char *ptr; /* current position into the buff */ Bool buff_alloc_size; /* mallocated size (iff output) */ } StrSInf; /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef STREAM_SUPP_FILE StmInf **pl_stm_tbl; int pl_stm_tbl_size; int pl_stm_last_used; char *pl_alias_tbl; WamWord pl_last_input_sora; WamWord pl_last_output_sora; int pl_stm_stdin; int pl_stm_stdout; int pl_stm_stderr; int pl_stm_input; int pl_stm_output; int pl_stm_error; int pl_stm_top_level_input; int pl_stm_top_level_output; int pl_stm_debugger_input; int pl_stm_debugger_output; Bool pl_stream_use_linedit; char *pl_le_prompt; int pl_use_le_prompt; int pl_atom_stream; int pl_atom_user_input; int pl_atom_user_output; int pl_atom_user_error; int pl_atom_top_level_input; int pl_atom_top_level_output; int pl_atom_debugger_input; int pl_atom_debugger_output; int pl_atom_read; int pl_atom_write; int pl_atom_append; int pl_atom_reposition; int pl_atom_stream_position; int pl_atom_text; int pl_atom_binary; int pl_atom_error; int pl_atom_eof_code; int pl_atom_reset; int pl_atom_none; int pl_atom_line; int pl_atom_block; int pl_atom_not; int pl_atom_at; int pl_atom_past; int pl_atom_bof; int pl_atom_current; int pl_atom_eof; #else extern StmInf **pl_stm_tbl; extern int pl_stm_tbl_size; extern int pl_stm_last_used; extern char *pl_alias_tbl; extern WamWord pl_last_input_sora; extern WamWord pl_last_output_sora; extern int pl_stm_stdin; extern int pl_stm_stdout; extern int pl_stm_stderr; extern int pl_stm_input; extern int pl_stm_output; extern int pl_stm_error; extern int pl_stm_top_level_input; extern int pl_stm_top_level_output; extern int pl_stm_debugger_input; extern int pl_stm_debugger_output; extern Bool pl_stream_use_linedit; extern char *pl_le_prompt; extern int pl_use_le_prompt; extern int pl_atom_stream; extern int pl_atom_user_input; extern int pl_atom_user_output; extern int pl_atom_top_level_input; extern int pl_atom_top_level_output; extern int pl_atom_debugger_input; extern int pl_atom_debugger_output; extern int pl_atom_read; extern int pl_atom_write; extern int pl_atom_append; extern int pl_atom_reposition; extern int pl_atom_stream_position; extern int pl_atom_text; extern int pl_atom_binary; extern int pl_atom_error; extern int pl_atom_eof_code; extern int pl_atom_reset; extern int pl_atom_none; extern int pl_atom_line; extern int pl_atom_block; extern int pl_atom_not; extern int pl_atom_at; extern int pl_atom_past; extern int pl_atom_bof; extern int pl_atom_current; extern int pl_atom_eof; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ int Pl_Add_Stream(int atom_file_name, PlLong file, StmProp prop, StmFct fct_getc, StmFct fct_putc, StmFct fct_flush, StmFct fct_close, StmFct fct_tell, StmFct fct_seek, StmFct fct_clearerr); int Pl_Add_Stream_For_Stdio_Desc(FILE *f, int atom_path, int mode, int text); int Pl_Add_Stream_For_Stdio_File(char *path, int mode, Bool text); void Pl_Delete_Stream(int stm); int Pl_Find_Stream_By_Alias(int atom_alias); Bool Pl_Add_Alias_To_Stream(int atom_alias, int stm); void Pl_Reassign_Alias(int atom_alias, int stm); void Pl_Add_Mirror_To_Stream(int stm, int m_stm); Bool Pl_Del_Mirror_From_Stream(int stm, int m_stm); int Pl_Find_Stream_From_PStm(StmInf *pstm); void Pl_Flush_All_Streams(void); void Pl_Set_Stream_Buffering(int stm); int Pl_Get_Stream_Or_Alias(WamWord sora_word, int test_mask); void Pl_Check_Stream_Type(int stm, Bool check_text, Bool for_input); WamWord Pl_Make_Stream_Tagged_Word(int stm); Bool Pl_Stdio_Is_Repositionable(FILE *f); void Pl_Stdio_Set_Buffering(FILE *f, int buffering); FILE *Pl_Stdio_Desc_Of_Stream(int stm); int Pl_Io_Fileno_Of_Stream(int stm); void Pl_PB_Empty_Buffer(StmInf *pstm); int Pl_Stream_Get_Key(StmInf *pstm, Bool echo, Bool catch_ctrl_c); int Pl_Stream_Getc(StmInf *pstm); void Pl_Stream_Ungetc(int c, StmInf *pstm); int Pl_Stream_Peekc(StmInf *pstm); char *Pl_Stream_Gets(char *str, int size, StmInf *pstm); char *Pl_Stream_Gets_Prompt(char *prompt, StmInf *pstm_o, char *str, int size, StmInf *pstm_i); void Pl_Stream_Putc(int c, StmInf *pstm); int Pl_Stream_Puts(char *str, StmInf *pstm); int Pl_Stream_Printf(StmInf *pstm, char *format, ...); void Pl_Stream_Flush(StmInf *pstm); int Pl_Stream_Close(StmInf *pstm); int Pl_Stream_End_Of_Stream(StmInf *pstm); void Pl_Stream_Get_Position(StmInf *pstm, PlLong *offset, PlLong *char_count, PlLong *line_count, PlLong *line_pos); int Pl_Stream_Set_Position(StmInf *pstm, int whence, PlLong offset, PlLong char_count, PlLong line_count, PlLong line_pos); int Pl_Stream_Set_Position_LC(StmInf *pstm, PlLong line_count, PlLong line_pos); int Pl_Add_Str_Stream(char *buff, int prop_other); void Pl_Delete_Str_Stream(int stm); char *Pl_Term_Write_Str_Stream(int stm); void Pl_Close_Stm(int stm, Bool force); /* from close_c.c */ #define PB_Init(pb) pb.ptr = pb.buff, pb.nb_elems = 0; #define PB_Is_Empty(pb) (pb.nb_elems == 0) #define PB_Push(pb, elem) \ do \ { \ *(pb.ptr) = (elem); \ if (pb.ptr != pb.buff + STREAM_PB_SIZE - 1) \ pb.ptr++; \ else \ pb.ptr = pb.buff; \ if (pb.nb_elems < STREAM_PB_SIZE) \ pb.nb_elems++; \ } \ while (0) #define PB_Pop(pb, elem) \ do \ { \ if (pb.ptr != pb.buff) \ pb.ptr--; \ else \ pb.ptr = pb.buff + STREAM_PB_SIZE - 1; \ (elem) = *pb.ptr; \ pb.nb_elems--; \ } \ while (0) #define PB_Top(pb, elem) \ do \ { \ if (pb.ptr != pb.buff) \ (elem) = pb.ptr[-1]; \ else \ (elem) = pb.buff[STREAM_PB_SIZE - 1]; \ } \ while (0) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/catch.wam������������������������������������������������������������������0000644�0001750�0001750�00000013347�13021356407�015103� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : catch.pl file_name('/home/diaz/GP/src/BipsPl/catch.pl'). predicate(system:'$use_catch'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:'$catch'/6,43,static,private,monofile,built_in,[ put_integer(1,6), call_c('Pl_Save_Call_Info_3',[],[x(4),x(5),x(6)]), put_integer(0,4), execute('$catch1'/5)]). predicate(system:'$catch_no_debug'/6,47,static,private,monofile,built_in,[ put_integer(0,6), call_c('Pl_Save_Call_Info_3',[],[x(4),x(5),x(6)]), put_integer(0,4), execute('$catch1'/5)]). predicate(system:'$catch1'/5,52,static,private,monofile,built_in,[ put_integer(4,5), call_c('Pl_Load_Call_Info_Arg_1',[],[x(5)]), execute('$catch_internal'/5)]). predicate(system:'$catch_internal'/5,59,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_integer(7,0), put_variable(y(5),1), call('$sys_var_read'/2), put_integer(8,0), put_atom('$no_ball$',1), call('$sys_var_put'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_unsafe_value(y(5),5), deallocate, execute('$catch_internal1'/6)]). predicate(system:'$catch_internal1'/6,65,static,private,monofile,built_in,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(7), get_variable(y(0),0), get_variable(y(1),3), get_variable(y(2),4), get_variable(y(3),5), get_variable(y(4),6), put_variable(y(5),0), call('$get_current_B'/1), put_integer(7,0), put_value(y(5),1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), call('$call_internal'/3), put_variable(y(6),0), call('$get_current_B'/1), put_value(y(6),0), put_value(y(5),1), put_value(y(4),2), call('$$catch_internal1/6_$aux1'/3), put_integer(7,0), put_value(y(3),1), deallocate, execute('$sys_var_write'/2), label(1), trust_me_else_fail, allocate(6), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), put_integer(7,0), put_value(y(4),1), call('$sys_var_write'/2), put_integer(8,0), put_variable(y(5),1), call('$sys_var_get'/2), put_unsafe_value(y(5),0), put_atom('$no_ball$',1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_unsafe_value(y(5),0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), put_value(y(3),4), put_value(y(4),5), deallocate, execute('$catch_a_throw'/6)]). predicate(system:'$$catch_internal1/6_$aux1'/3,65,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),2), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(2)]), cut(x(3)), put_value(x(1),0), execute('$trail_handler'/1), label(1), trust_me_else_fail, cut(x(2)), proceed]). predicate(system:'$catch_a_throw'/6,94,static,private,monofile,built_in,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), get_structure('$catch_sync'/1,0), unify_variable(x(1)), cut(x(6)), put_value(x(5),0), execute('$$catch_a_throw/6_$aux1'/2), label(1), retry_me_else(2), allocate(3), get_variable(y(0),2), get_variable(y(1),3), get_variable(y(2),4), get_value(x(1),0), cut(x(6)), put_integer(8,0), put_atom('$no_ball$',1), call('$sys_var_put'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute('$call_internal'/3), label(2), trust_me_else_fail, execute('$unwind'/1)]). predicate(system:'$$catch_a_throw/6_$aux1'/2,94,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),3), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), put_structure('$catch_sync'/1,0), unify_local_value(x(1)), execute('$unwind'/1), label(1), trust_me_else_fail, put_value(x(1),0), execute('$catch_fail_now'/1)]). predicate(system:'$trail_handler'/1,120,static,private,monofile,built_in,[ try_me_else(1), proceed, label(1), trust_me_else_fail, allocate(0), put_value(x(0),1), put_integer(7,0), call('$sys_var_write'/2), fail]). predicate(system:'$catch_sync_for_fail_at'/1,129,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), put_integer(7,0), put_variable(y(1),1), call('$sys_var_read'/2), put_unsafe_value(y(1),0), put_value(y(0),1), deallocate, execute('$$catch_sync_for_fail_at/1_$aux1'/2)]). predicate(system:'$$catch_sync_for_fail_at/1_$aux1'/2,129,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),3), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), put_structure('$catch_sync'/1,0), unify_local_value(x(1)), put_atom(system,1), put_atom('$catch_sync_for_fail_at',2), put_integer(1,3), execute('$throw'/4), label(1), trust_me_else_fail, execute('$catch_fail_now'/1)]). predicate(system:'$catch_fail_now'/1,141,static,private,monofile,built_in,[ allocate(0), call('$set_current_B'/1), fail]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/unify.wam������������������������������������������������������������������0000644�0001750�0001750�00000001223�13021356407�015141� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : unify.pl file_name('/home/diaz/GP/src/BipsPl/unify.pl'). predicate(system:'$use_unify'/0,42,static,private,monofile,built_in,[ proceed]). predicate(system:(=)/2,45,static,private,monofile,built_in,[ get_value(x(1),0), proceed]). predicate(system:unify_with_occurs_check/2,50,static,private,monofile,built_in,[ call_c('Pl_Unify_Occurs_Check',[boolean,fast_call],[x(0),x(1)]), proceed]). predicate(system:(\=)/2,56,static,private,monofile,built_in,[ put_structure((=)/2,2), unify_local_value(x(0)), unify_local_value(x(1)), put_meta_term(system,2,0), execute((\+)/1)]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/all_solut.wam��������������������������������������������������������������0000644�0001750�0001750�00000015454�13021356407�016020� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : all_solut.pl file_name('/home/diaz/GP/src/BipsPl/all_solut.pl'). predicate(system:'$use_all_solut'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:findall/3,50,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(2),0), put_atom(findall,1), put_integer(3,2), call('$check_list_arg'/3), put_value(y(1),0), put_variable(y(3),1), put_variable(y(4),2), call('$strip_module_nonvar'/3), put_value(y(0),0), put_unsafe_value(y(4),1), put_unsafe_value(y(3),2), put_value(y(2),3), put_nil(4), put_atom(findall,5), put_integer(3,6), deallocate, execute('$findall'/7)]). predicate(system:findall/4,55,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(2),0), put_atom(findall,1), put_integer(4,2), call('$check_list_arg'/3), put_value(y(1),0), put_variable(y(4),1), put_variable(y(5),2), call('$strip_module_nonvar'/3), put_value(y(0),0), put_unsafe_value(y(5),1), put_unsafe_value(y(4),2), put_value(y(2),3), put_value(y(3),4), put_atom(findall,5), put_integer(4,6), deallocate, execute('$findall'/7)]). predicate(system:'$findall'/7,60,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),3), get_variable(y(1),4), put_value(x(5),4), put_value(x(6),5), put_variable(y(2),3), call('$store_solutions'/6), put_unsafe_value(y(2),0), put_integer(0,1), put_value(y(0),2), put_value(y(1),3), deallocate, call_c('Pl_Recover_Solutions_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:setof/3,67,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(2),0), put_atom(setof,1), put_integer(3,2), call('$check_list_arg'/3), put_value(y(1),0), put_variable(y(3),1), put_variable(y(4),2), call('$strip_module_nonvar'/3), put_value(y(0),0), put_unsafe_value(y(4),1), put_unsafe_value(y(3),2), put_value(y(2),3), put_atom(setof,4), put_integer(3,5), deallocate, execute('$bagof'/6)]). predicate(system:bagof/3,76,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(2),0), put_atom(bagof,1), put_integer(3,2), call('$check_list_arg'/3), put_value(y(1),0), put_variable(y(3),1), put_variable(y(4),2), call('$strip_module_nonvar'/3), put_value(y(0),0), put_unsafe_value(y(4),1), put_unsafe_value(y(3),2), put_value(y(2),3), put_atom(bagof,4), put_integer(3,5), deallocate, execute('$bagof'/6)]). predicate(system:'$bagof'/6,82,static,private,monofile,built_in,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(6), get_variable(y(0),3), get_variable(y(1),4), get_variable(y(2),5), get_variable(x(4),1), get_variable(x(3),0), put_variable(x(1),0), put_variable(y(3),5), call_c('Pl_Free_Variables_4',[boolean],[x(3),x(4),x(0),x(5)]), cut(x(6)), put_structure((-)/2,0), unify_local_value(y(3)), unify_local_value(x(3)), put_variable(y(4),3), put_value(y(1),4), put_value(y(2),5), call('$store_solutions'/6), put_value(y(1),0), put_value(y(2),1), call_c('Pl_Set_Bip_Name_2',[],[x(0),x(1)]), put_value(y(4),0), put_integer(1,1), put_variable(y(5),2), put_nil(3), call_c('Pl_Recover_Solutions_4',[boolean],[x(0),x(1),x(2),x(3)]), put_value(y(1),0), put_value(y(5),1), call('$$bagof/6_$aux1'/2), put_unsafe_value(y(5),0), put_unsafe_value(y(3),1), put_value(y(0),2), deallocate, execute('$group_solutions'/3), label(1), trust_me_else_fail, allocate(2), get_variable(y(0),3), get_variable(y(1),4), put_variable(x(1),3), call_c('Pl_Recover_Generator_1',[],[x(3)]), put_value(x(5),6), put_value(y(0),3), put_nil(4), put_value(y(1),5), call('$findall'/7), put_value(y(0),0), put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_value(y(1),0), put_value(y(0),1), deallocate, execute('$$bagof/6_$aux2'/2)]). predicate(system:'$$bagof/6_$aux2'/2,93,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(bagof,0), cut(x(2)), proceed, label(1), trust_me_else_fail, put_value(x(1),0), execute(sort/1)]). predicate(system:'$$bagof/6_$aux1'/2,82,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(bagof,0), cut(x(2)), put_value(x(1),0), execute(keysort/1), label(1), trust_me_else_fail, put_value(x(1),0), execute(sort/1)]). predicate(system:'$store_solutions'/6,105,static,private,monofile,built_in,[ get_variable(x(6),4), get_variable(x(4),0), call_c('Pl_Stop_Mark_1',[],[x(3)]), put_value(x(1),0), put_value(x(2),1), put_value(x(6),2), put_value(x(5),3), execute('$$store_solutions/6_$aux1'/5)]). predicate(system:'$$store_solutions/6_$aux1'/5,105,static,private,monofile,local,[ try_me_else(1), allocate(1), get_variable(y(0),4), call('$call'/4), put_value(y(0),0), call_c('Pl_Store_Solution_1',[],[x(0)]), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$group_solutions'/3,116,static,private,monofile,built_in,[ call_c('Pl_Group_Solutions_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$group_solutions_alt'/0,119,static,private,monofile,built_in,[ call_c('Pl_Group_Solutions_Alt_0',[boolean],[]), proceed]). predicate(system:'$check_list_arg'/3,127,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_2',[],[x(1),x(2)]), execute('$check_list_or_partial_list'/1)]). directive(43,system,[ put_atom(user,0), put_structure(findall/3,1), unify_atom(?), unify_integer(0), unify_atom(-), execute('$declare_meta_predicate'/2)]). directive(44,system,[ put_atom(user,0), put_structure(findall/4,1), unify_atom(?), unify_integer(0), unify_atom(-), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(45,system,[ put_atom(user,0), put_structure(bagof/3,1), unify_atom(?), unify_integer(0), unify_atom(-), execute('$declare_meta_predicate'/2)]). directive(46,system,[ put_atom(user,0), put_structure(setof/3,1), unify_atom(?), unify_integer(0), unify_atom(-), execute('$declare_meta_predicate'/2)]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/const_io.wam���������������������������������������������������������������0000644�0001750�0001750�00000023472�13021356407�015636� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : const_io.pl file_name('/home/diaz/GP/src/BipsPl/const_io.pl'). predicate(system:'$use_const_io'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:write_to_atom/2,46,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_to_atom,2]), call_c('Pl_Write_To_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:write_to_chars/2,50,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_to_chars,2]), call_c('Pl_Write_To_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:write_to_codes/2,54,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_to_codes,2]), call_c('Pl_Write_To_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:writeq_to_atom/2,61,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[writeq_to_atom,2]), call_c('Pl_Writeq_To_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:writeq_to_chars/2,65,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[writeq_to_chars,2]), call_c('Pl_Writeq_To_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:writeq_to_codes/2,69,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[writeq_to_codes,2]), call_c('Pl_Writeq_To_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:write_canonical_to_atom/2,76,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_canonical_to_atom,2]), call_c('Pl_Write_Canonical_To_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:write_canonical_to_chars/2,80,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_canonical_to_chars,2]), call_c('Pl_Write_Canonical_To_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:write_canonical_to_codes/2,84,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_canonical_to_codes,2]), call_c('Pl_Write_Canonical_To_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:display_to_atom/2,91,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[display_to_atom,2]), call_c('Pl_Display_To_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:display_to_chars/2,95,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[display_to_chars,2]), call_c('Pl_Display_To_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:display_to_codes/2,99,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[display_to_codes,2]), call_c('Pl_Display_To_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:print_to_atom/2,106,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[print_to_atom,2]), call_c('Pl_Print_To_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:print_to_chars/2,110,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[print_to_chars,2]), call_c('Pl_Print_To_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:print_to_codes/2,114,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[print_to_codes,2]), call_c('Pl_Print_To_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:write_term_to_atom/3,121,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_term_to_atom,3]), call('$set_write_defaults'/0), put_value(y(2),0), call('$get_write_options'/1), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Write_Term_To_Atom_2',[],[x(0),x(1)]), proceed]). predicate(system:write_term_to_chars/3,127,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_term_to_chars,3]), call('$set_write_defaults'/0), put_value(y(2),0), call('$get_write_options'/1), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Write_Term_To_Chars_2',[],[x(0),x(1)]), proceed]). predicate(system:write_term_to_codes/3,133,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_term_to_codes,3]), call('$set_write_defaults'/0), put_value(y(2),0), call('$get_write_options'/1), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Write_Term_To_Codes_2',[],[x(0),x(1)]), proceed]). predicate(system:format_to_atom/3,142,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[format_to_atom,3]), call_c('Pl_Format_To_Atom_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:format_to_chars/3,146,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[format_to_chars,3]), call_c('Pl_Format_To_Chars_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:format_to_codes/3,150,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[format_to_codes,3]), call_c('Pl_Format_To_Codes_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:read_from_atom/2,157,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_from_atom,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_From_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_from_chars/2,162,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_from_chars,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_From_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_from_codes/2,167,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_from_codes,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_From_Codes_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_term_from_atom/3,175,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_term_from_atom,3]), call('$set_read_defaults'/0), put_value(y(2),0), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),3), call('$get_read_options'/4), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), put_unsafe_value(y(5),4), deallocate, call_c('Pl_Read_Term_From_Atom_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:read_term_from_chars/3,181,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_term_from_chars,3]), call('$set_read_defaults'/0), put_value(y(2),0), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),3), call('$get_read_options'/4), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), put_unsafe_value(y(5),4), deallocate, call_c('Pl_Read_Term_From_Chars_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:read_term_from_codes/3,187,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_term_from_codes,3]), call('$set_read_defaults'/0), put_value(y(2),0), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),3), call('$get_read_options'/4), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), put_unsafe_value(y(5),4), deallocate, call_c('Pl_Read_Term_From_Codes_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:read_token_from_atom/2,196,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_token_from_atom,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_Token_From_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_token_from_chars/2,201,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_token_from_chars,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_Token_From_Chars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_token_from_codes/2,206,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_token_from_codes,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_Token_From_Codes_2',[boolean],[x(0),x(1)]), proceed]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/top_level_c.c��������������������������������������������������������������0000644�0001750�0001750�00000014555�13021324543�015750� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : top_level_c.c * * Descr.: top Level - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "gp_config.h" #ifndef NO_USE_LINEDIT #include "ctrl_c.h" #else #include "../Linedit/ctrl_c.c" /* must be included before other .h... */ #endif #include "engine_pl.h" #include "bips_pl.h" #include <string.h> #include <stdlib.h> #include <signal.h> /*---------------------------------* * Constants * *---------------------------------*/ /* Error Messages */ #define ERR_DEBUGGER_NOT_FOUND "top_level_c: debug/trace not found" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #if !defined(NO_USE_REGS) && NB_OF_USED_MACHINE_REGS > 0 static WamWord buff_save_machine_regs[NB_OF_USED_MACHINE_REGS]; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define ABORT X0_abort #define BREAK X0_break Prolog_Prototype(ABORT, 0); Prolog_Prototype(BREAK, 0); static PlLong Ctrl_C_Manager(int from_callback); /*-------------------------------------------------------------------------* * PL_SET_CTRL_C_HANDLER_0 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Ctrl_C_Handler_0(void) { Pl_Install_Ctrl_C_Handler(Ctrl_C_Manager); } /*-------------------------------------------------------------------------* * PL_SAVE_REGS_FOR_SIGNAL * * * *-------------------------------------------------------------------------*/ void Pl_Save_Regs_For_Signal(void) { Save_Machine_Regs(buff_save_machine_regs); } /*-------------------------------------------------------------------------* * CTRL_C_MANAGER * * * *-------------------------------------------------------------------------*/ static PlLong Ctrl_C_Manager(int from_callback) { StmInf *pstm = pl_stm_tbl[pl_stm_top_level_output]; PredInf *pred; int c; CodePtr to_execute; // Pl_Reset_Prolog_In_Signal(); Restore_Machine_Regs(buff_save_machine_regs); start: Pl_Stream_Printf(pstm, "\nProlog interruption (h for help) ? "); Pl_Stream_Flush(pstm); c = Pl_Stream_Get_Key(pl_stm_tbl[pl_stm_top_level_input], TRUE, FALSE); Pl_Stream_Putc('\n', pstm); switch (c) { case 'a': /* abort */ to_execute = Prolog_Predicate(ABORT, 0); if (from_callback) return (PlLong) to_execute; Pl_Execute_A_Continuation(to_execute); break; case 'b': /* break */ Pl_Call_Prolog(Prolog_Predicate(BREAK, 0)); goto start; break; case 'c': /* continue */ break; case 'e': /* exit */ Pl_Exit_With_Value(0); case 't': /* trace */ case 'd': /* debug */ if (SYS_VAR_DEBUGGER) { pred = Pl_Check_Sys_Pred_Exist((c == 't') ? "trace" : "debug", 0); if (pred == NULL) Pl_Fatal_Error(ERR_DEBUGGER_NOT_FOUND); /* should not occur */ Pl_Call_Prolog((CodePtr) pred->codep); break; } default: /* help */ Pl_Stream_Printf(pstm, " a abort b break\n"); Pl_Stream_Printf(pstm, " c continue e exit\n"); if (SYS_VAR_DEBUGGER) Pl_Stream_Printf(pstm, " d debug t trace\n"); Pl_Stream_Printf(pstm, " h/? help\n"); goto start; } return 0; } ���������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/write_c.c������������������������������������������������������������������0000644�0001750�0001750�00000025436�13021324543�015111� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : write_c.c * * Descr.: term output (write/1 and friends) management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_WRITE_TERM_2 * * * *-------------------------------------------------------------------------*/ void Pl_Write_Term_2(WamWord sora_word, WamWord term_word) { int stm; StmInf *pstm; WamWord *above_H = NULL; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pstm = pl_stm_tbl[stm]; pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); if (SYS_VAR_WRITE_ABOVE > 0) { WamWord *b = LSSA + SYS_VAR_WRITE_ABOVE; /* see Pl_Get_Current_Choice / Pl_Cut */ above_H = HB(b); } Pl_Write_Term(pstm, SYS_VAR_WRITE_DEPTH, SYS_VAR_WRITE_PREC, SYS_VAR_OPTION_MASK, above_H, term_word); } /*-------------------------------------------------------------------------* * PL_WRITE_TERM_1 * * * *-------------------------------------------------------------------------*/ void Pl_Write_Term_1(WamWord term_word) { Pl_Write_Term_2(NOT_A_WAM_WORD, term_word); } /*-------------------------------------------------------------------------* * PL_WRITE_1 * * * *-------------------------------------------------------------------------*/ void Pl_Write_1(WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_NUMBER_VARS | WRITE_NAME_VARS; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(NOT_A_WAM_WORD, term_word); } /*-------------------------------------------------------------------------* * PL_WRITE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Write_2(WamWord sora_word, WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_NUMBER_VARS | WRITE_NAME_VARS; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(sora_word, term_word); } /*-------------------------------------------------------------------------* * PL_WRITEQ_1 * * * *-------------------------------------------------------------------------*/ void Pl_Writeq_1(WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_QUOTED; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(NOT_A_WAM_WORD, term_word); } /*-------------------------------------------------------------------------* * PL_WRITEQ_2 * * * *-------------------------------------------------------------------------*/ void Pl_Writeq_2(WamWord sora_word, WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_QUOTED; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(sora_word, term_word); } /*-------------------------------------------------------------------------* * PL_WRITE_CANONICAL_1 * * * *-------------------------------------------------------------------------*/ void Pl_Write_Canonical_1(WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_IGNORE_OP | WRITE_QUOTED; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(NOT_A_WAM_WORD, term_word); } /*-------------------------------------------------------------------------* * PL_WRITE_CANONICAL_2 * * * *-------------------------------------------------------------------------*/ void Pl_Write_Canonical_2(WamWord sora_word, WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_IGNORE_OP | WRITE_QUOTED; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(sora_word, term_word); } /*-------------------------------------------------------------------------* * PL_DISPLAY_1 * * * *-------------------------------------------------------------------------*/ void Pl_Display_1(WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_IGNORE_OP; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(NOT_A_WAM_WORD, term_word); } /*-------------------------------------------------------------------------* * PL_DISPLAY_2 * * * *-------------------------------------------------------------------------*/ void Pl_Display_2(WamWord sora_word, WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_IGNORE_OP; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(sora_word, term_word); } /*-------------------------------------------------------------------------* * PL_PRINT_1 * * * * NB: the definition of the predicate print/1-2 is in the file print.pl * * to avoid to link call/1 if print is not used. * *-------------------------------------------------------------------------*/ void Pl_Print_1(WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_PORTRAYED; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(NOT_A_WAM_WORD, term_word); } /*-------------------------------------------------------------------------* * PL_PRINT_2 * * * *-------------------------------------------------------------------------*/ void Pl_Print_2(WamWord sora_word, WamWord term_word) { SYS_VAR_OPTION_MASK = WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_PORTRAYED; SYS_VAR_WRITE_DEPTH = -1; SYS_VAR_WRITE_PREC = MAX_PREC; Pl_Write_Term_2(sora_word, term_word); } /*-------------------------------------------------------------------------* * PL_NL_1 * * * *-------------------------------------------------------------------------*/ void Pl_Nl_1(WamWord sora_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); Pl_Stream_Putc('\n', pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_NL_0 * * * *-------------------------------------------------------------------------*/ void Pl_Nl_0(void) { Pl_Nl_1(NOT_A_WAM_WORD); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pretty.pl������������������������������������������������������������������0000644�0001750�0001750�00000012776�13021324543�015200� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pretty.pl * * Descr.: pretty print clause management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_pretty'. portray_clause(Term) :- '$portray_clause'(Term, 1, AboveB), '$call_c'('Pl_Portray_Clause_2'(Term, AboveB)), fail. portray_clause(_). portray_clause(SorA, Term) :- '$portray_clause'(Term, 2, AboveB), '$call_c'('Pl_Portray_Clause_3'(SorA, Term, AboveB)), fail. portray_clause(_, _). '$portray_clause'(Term, Arity, AboveB) :- % create choice point for '$above'/1 write option '$get_current_B'(AboveB), set_bip_name(portray_clause, Arity), ( var(Term) -> '$pl_err_instantiation' ; true ), ( callable(Term) -> true ; '$pl_err_type'(callable, Term) ), name_singleton_vars(Term), bind_variables(Term, [exclude([Term])]), set_bip_name(portray_clause, Arity). '$portray_clause'(_, _, _) :- fail. name_singleton_vars(Term) :- set_bip_name(name_singleton_vars, 1), '$call_c'('Pl_Name_Singleton_Vars_1'(Term)). name_query_vars(QueryVars, RestVars) :- set_bip_name(name_query_vars, 2), '$call_c_test'('Pl_Name_Query_Vars_2'(QueryVars, RestVars)). % sys_var[0]:0 if numbervars bindings, 1 if namevars bindings bind_variables(Term, Options) :- set_bip_name(bind_variables, 2), '$set_bind_variables_defaults', '$get_bind_variables_options'(Options, Exclude, From, Next), '$bind_variables'(Term, Exclude, From, Next). '$bind_variables'(Term, Exclude, From, Next) :- '$call_c_test'('Pl_Bind_Variables_4'(Term, Exclude, From, Next)). '$set_bind_variables_defaults' :- '$sys_var_write'(0, 0). '$get_bind_variables_options'(Options, Exclude, From, Next) :- '$check_list'(Options), g_assign('$bind_exclude', []), g_assign('$bind_from', 0), g_assign('$bind_next', _), '$get_bind_variables_options1'(Options), g_read('$bind_exclude', Exclude), g_read('$bind_from', From), g_read('$bind_next', Next). '$get_bind_variables_options1'([]). '$get_bind_variables_options1'([X|Options]) :- '$get_bind_variables_options2'(X), !, '$get_bind_variables_options1'(Options). '$get_bind_variables_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_bind_variables_options2'(exclude(Exclude)) :- g_link('$bind_exclude', Exclude). '$get_bind_variables_options2'(from(From)) :- '$check_nonvar'(From), integer(From), g_link('$bind_from', From). '$get_bind_variables_options2'(next(Next)) :- '$check_nonvar'(Next), integer(Next), g_link('$bind_next', Next). '$get_bind_variables_options2'(numbervars) :- '$sys_var_write'(0, 0). '$get_bind_variables_options2'(namevars) :- '$sys_var_write'(0, 1). '$get_bind_variables_options2'(X) :- '$pl_err_domain'(var_binding_option, X). numbervars(Term) :- set_bip_name(numbervars, 1), '$set_bind_variables_defaults', '$bind_variables'(Term, [], 0, _). numbervars(Term, From, Next) :- set_bip_name(numbervars, 3), '$set_bind_variables_defaults', '$bind_variables'(Term, [], From, Next). ��gprolog-1.4.5/src/BipsPl/g_var_inl.wam��������������������������������������������������������������0000644�0001750�0001750�00000005110�13021356407�015746� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : g_var_inl.pl file_name('/home/diaz/GP/src/BipsPl/g_var_inl.pl'). predicate(system:'$use_g_var_inl'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:g_assign/2,44,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed]). predicate(system:g_assignb/2,50,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Assignb',[fast_call],[x(0),x(1)]), proceed]). predicate(system:g_link/2,56,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), proceed]). predicate(system:g_read/2,62,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_array_size/2,68,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Array_Size',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_inc/1,73,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Inc',[fast_call],[x(0)]), proceed]). predicate(system:g_inco/2,77,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Inco',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_inc/2,81,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Inc_2',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_inc/3,85,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Inc_3',[fast_call,boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:g_dec/1,91,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Dec',[fast_call],[x(0)]), proceed]). predicate(system:g_deco/2,95,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Deco',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_dec/2,99,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Dec_2',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_dec/3,103,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Dec_3',[fast_call,boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:g_set_bit/2,109,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Set_Bit',[fast_call],[x(0),x(1)]), proceed]). predicate(system:g_reset_bit/2,115,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Reset_Bit',[fast_call],[x(0),x(1)]), proceed]). predicate(system:g_test_set_bit/2,121,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Test_Set_Bit',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:g_test_reset_bit/2,127,static,private,monofile,built_in,[ call_c('Pl_Blt_G_Test_Reset_Bit',[fast_call,boolean],[x(0),x(1)]), proceed]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pred_supp.h����������������������������������������������������������������0000644�0001750�0001750�00000006557�13021324543�015466� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pred_supp.h * * Descr.: predicate management support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ char *Pl_Detect_If_Aux_Name(int func); int Pl_Father_Pred_Of_Aux(int func, int *father_arity); int Pl_Pred_Without_Aux(int func, int arity, int *arity1); int Pl_Make_Aux_Name(int func, int arity, int aux_nb); �������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/le_interf_c.c��������������������������������������������������������������0000644�0001750�0001750�00000015004�13021324543�015714� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : le_interf_c.c * * Descr.: linedit interface management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <ctype.h> #include "engine_pl.h" #include "bips_pl.h" #include "linedit.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define FIND_LINEDIT_COMPLETION_ALT X1_2466696E645F6C696E656469745F636F6D706C6574696F6E5F616C74 Prolog_Prototype(FIND_LINEDIT_COMPLETION_ALT, 0); /*-------------------------------------------------------------------------* * PL_GET_LINEDIT_PROMPT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Linedit_Prompt_1(WamWord prompt_word) { return Pl_Un_String_Check(pl_le_prompt, prompt_word); } /*-------------------------------------------------------------------------* * PL_SET_LINEDIT_PROMPT_1 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Linedit_Prompt_1(WamWord prompt_word) { pl_le_prompt = pl_atom_tbl[Pl_Rd_Atom_Check(prompt_word)].name; } /*-------------------------------------------------------------------------* * PL_ADD_LINEDIT_COMPLETION_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Add_Linedit_Completion_1(WamWord compl_word) { int atom; AtomProp prop; char *p; atom = Pl_Rd_Atom_Check(compl_word); prop = pl_atom_tbl[atom].prop; if (prop.length == 0) return FALSE; if (prop.type != IDENTIFIER_ATOM) { for (p = pl_atom_tbl[atom].name; *p; p++) if (!isalnum(*p) && *p != '_') return FALSE; } Pl_LE_Compl_Add_Word(pl_atom_tbl[atom].name, prop.length); return TRUE; } /*-------------------------------------------------------------------------* * PL_FIND_LINEDIT_COMPLETION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Find_Linedit_Completion_2(WamWord prefix_word, WamWord compl_word) { char *prefix = Pl_Rd_String_Check(prefix_word); int nb_match, max_lg, is_last; char *compl; Pl_Check_For_Un_Atom(compl_word); if (Pl_LE_Compl_Init_Match(prefix, &nb_match, &max_lg) == NULL) return FALSE; compl = Pl_LE_Compl_Find_Match(&is_last); if (!is_last) /* non deterministic case */ { A(0) = compl_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(FIND_LINEDIT_COMPLETION_ALT, 0), 1); } return Pl_Get_Atom(Pl_Create_Atom(compl), compl_word); } /*-------------------------------------------------------------------------* * PL_FIND_LINEDIT_COMPLETION_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Find_Linedit_Completion_Alt_0(void) { WamWord compl_word; int is_last; char *compl; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(FIND_LINEDIT_COMPLETION_ALT, 0), 0); compl_word = AB(B, 0); compl = Pl_LE_Compl_Find_Match(&is_last); if (is_last) Delete_Last_Choice_Point(); return Pl_Get_Atom(Pl_Create_Atom(compl), compl_word); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000132�13021324543�015263� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile tmp tmp1 LEAK.pl FLOAT.pl SOCKET.pl DCG.pl COMPAR_BYTE_INTER OKEEFE CALL_C CATCH ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/call.wam�������������������������������������������������������������������0000644�0001750�0001750�00000027545�13021356407�014741� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : call.pl file_name('/home/diaz/GP/src/BipsPl/call.pl'). predicate(system:'$use_call'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:once/1,45,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(1), get_variable(y(0),1), put_atom(system,1), put_atom(once,2), put_integer(1,3), call('$call'/4), cut(y(0)), deallocate, proceed]). predicate(system:(\+)/1,51,static,private,monofile,built_in,[ execute('$\\+/1_$aux1'/1)]). predicate(system:'$\\+/1_$aux1'/1,51,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_variable(y(0),1), put_atom(system,1), put_atom(\+,2), put_integer(1,3), call('$call'/4), cut(y(0)), fail, label(1), trust_me_else_fail, proceed]). predicate(system:call_det/2,61,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), put_value(y(1),0), call('$call_det/2_$aux1'/1), put_variable(y(2),0), call('$get_current_B'/1), put_value(y(0),0), put_atom(system,1), put_atom(call_det,2), put_integer(2,3), call('$call'/4), put_variable(y(3),0), call('$get_current_B'/1), put_unsafe_value(y(3),0), put_unsafe_value(y(2),1), put_value(y(1),2), deallocate, execute('$call_det/2_$aux2'/3)]). predicate(system:'$call_det/2_$aux2'/3,61,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(1)]), cut(x(3)), get_atom(false,2), proceed, label(1), trust_me_else_fail, get_atom(true,2), proceed]). predicate(system:'$call_det/2_$aux1'/1,61,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), put_atom(false,2), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(2)]), put_atom(true,2), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(2)]), cut(x(1)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[call,2]), put_value(x(0),1), put_atom(boolean,0), execute('$pl_err_type'/2), label(1), trust_me_else_fail, proceed]). predicate(system:'$call'/4,96,static,private,monofile,built_in,[ call_c('Pl_BC_Call_5',[jump,by_value],[x(0),x(1),x(2),x(3),1]), proceed]). predicate(system:'$call_no_debug'/4,100,static,private,monofile,built_in,[ call_c('Pl_BC_Call_5',[jump,by_value],[x(0),x(1),x(2),x(3),0]), proceed]). predicate(system:'$call_internal_and'/5,106,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), call('$call_internal_with_cut'/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4)]). predicate(system:'$call_internal_if'/5,110,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), cut(y(4)), put_value(y(1),1), put_value(y(2),2), call('$call_internal'/3), cut(y(4)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4)]). predicate(system:'$call_internal_soft_if'/5,117,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), allocate(4), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), cut(x(5)), put_value(y(1),1), put_value(y(2),2), call('$call_internal'/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4)]). predicate(system:'$call_internal'/3,125,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), execute('$call_internal_with_cut'/4)]). predicate(system:'$call_internal_with_cut'/4,134,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(4)), call_c('Pl_Call_Info_Bip_Name_1',[],[x(2)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(26), switch_on_term(4,2,fail,fail,3), label(2), switch_on_atom([(!,11),(fail,17),(true,19)]), label(3), switch_on_structure([((:)/2,5),((',')/2,7),((;)/2,9),((->)/2,13),((*->)/2,15),(call/1,21),(catch/3,23),(throw/1,25)]), label(4), try_me_else(6), label(5), get_structure((:)/2,0), unify_variable(x(1)), unify_variable(x(0)), cut(x(4)), execute('$call_internal_with_cut'/4), label(6), retry_me_else(8), label(7), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_structure((',')/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(4)), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), call('$call_internal_with_cut'/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4), label(8), retry_me_else(10), label(9), get_variable(x(5),3), get_variable(x(3),2), get_variable(x(2),1), get_structure((;)/2,0), unify_variable(x(0)), unify_variable(x(1)), cut(x(4)), put_value(x(5),4), execute('$call_internal_or'/5), label(10), retry_me_else(12), label(11), get_atom(!,0), cut(x(3)), proceed, label(12), retry_me_else(14), label(13), allocate(5), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_structure((->)/2,0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(4),4), cut(y(4)), put_value(y(1),1), put_value(y(2),2), call('$call_internal'/3), cut(y(4)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4), label(14), retry_me_else(16), label(15), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_structure((*->)/2,0), unify_variable(x(0)), unify_variable(y(0)), cut(x(4)), put_value(y(1),1), put_value(y(2),2), call('$call_internal'/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4), label(16), retry_me_else(18), label(17), get_atom(fail,0), cut(x(4)), fail, label(18), retry_me_else(20), label(19), get_atom(true,0), cut(x(4)), proceed, label(20), retry_me_else(22), label(21), get_structure(call/1,0), unify_variable(x(0)), cut(x(4)), execute('$call_internal'/3), label(22), retry_me_else(24), label(23), get_variable(x(5),2), get_variable(x(3),1), get_structure(catch/3,0), unify_variable(x(0)), unify_variable(x(1)), unify_variable(x(2)), cut(x(4)), put_value(x(5),4), execute('$catch_internal'/5), label(24), trust_me_else_fail, label(25), get_structure(throw/1,0), unify_variable(x(0)), cut(x(4)), execute('$throw_internal'/3), label(26), trust_me_else_fail, put_integer(1,3), call_c('Pl_BC_Call_Terminal_Pred_4',[jump],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$call_internal_or'/5,193,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(6), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([((->)/2,3),((*->)/2,5)]), label(2), try_me_else(4), label(3), get_variable(x(7),4), get_variable(x(6),1), get_structure((->)/2,0), unify_variable(x(0)), unify_variable(x(4)), cut(x(5)), put_value(x(2),1), put_value(x(3),2), put_value(x(5),3), put_value(x(7),5), execute('$$call_internal_or/5_$aux1'/7), label(4), trust_me_else_fail, label(5), get_variable(x(7),3), get_variable(x(6),1), get_structure((*->)/2,0), unify_variable(x(0)), unify_variable(x(3)), cut(x(5)), put_value(x(2),1), put_value(x(7),2), put_value(x(6),5), execute('$$call_internal_or/5_$aux2'/6), label(6), retry_me_else(7), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), execute('$call_internal_with_cut'/4), label(7), trust_me_else_fail, put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), execute('$call_internal_with_cut'/4)]). predicate(system:'$$call_internal_or/5_$aux2'/6,200,static,private,monofile,local,[ try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_current_choice(y(4)), put_value(y(0),1), put_value(y(1),2), call('$call_internal'/3), soft_cut(y(4)), put_value(y(2),0), put_value(y(0),1), put_value(y(1),2), put_value(y(3),3), deallocate, execute('$call_internal_with_cut'/4), label(1), trust_me_else_fail, put_value(x(5),0), put_value(x(4),3), execute('$call_internal_with_cut'/4)]). predicate(system:'$$call_internal_or/5_$aux1'/7,193,static,private,monofile,local,[ try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), put_value(y(0),1), put_value(y(1),2), call('$call_internal'/3), cut(y(2)), put_value(y(3),0), put_value(y(0),1), put_value(y(1),2), put_value(y(4),3), deallocate, execute('$call_internal_with_cut'/4), label(1), trust_me_else_fail, put_value(x(6),0), put_value(x(5),3), execute('$call_internal_with_cut'/4)]). predicate(system:'$call_from_debugger'/3,216,static,private,monofile,built_in,[ put_integer(0,3), call_c('Pl_BC_Call_Terminal_Pred_4',[jump],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:false/0,221,static,private,monofile,built_in,[ fail]). predicate(system:forall/2,227,static,private,monofile,built_in,[ get_variable(x(2),0), put_structure((',')/2,0), unify_local_value(x(2)), unify_structure('$not'/3), unify_local_value(x(1)), unify_atom(forall), unify_integer(2), put_atom(forall,1), put_integer(2,2), execute('$not'/3)]). predicate(system:'$not'/3,231,static,private,monofile,built_in,[ execute('$$not/3_$aux1'/3)]). predicate(system:'$$not/3_$aux1'/3,231,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(x(4),2), get_variable(y(0),3), put_value(x(1),2), put_value(x(4),3), put_atom(user,1), call('$call'/4), cut(y(0)), fail, label(1), trust_me_else_fail, proceed]). directive(43,system,[ put_atom(user,0), put_structure(once/1,1), unify_integer(0), execute('$declare_meta_predicate'/2)]). directive(49,system,[ put_atom(user,0), put_structure((\+)/1,1), unify_integer(0), execute('$declare_meta_predicate'/2)]). directive(59,system,[ put_atom(user,0), put_structure(call_det/2,1), unify_integer(0), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(225,system,[ put_atom(user,0), put_structure(forall/2,1), unify_integer(0), unify_integer(0), execute('$declare_meta_predicate'/2)]). �����������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/utils.pl�������������������������������������������������������������������0000644�0001750�0001750�00000013474�13021324543�015005� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : utils.pl * * Descr.: utilities * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$get_head_and_body'(Clause, Module, Head, Body) :- '$call_c_test'('Pl_Get_Head_And_Body_4'(Clause, Module, Head, Body)). '$term_to_goal'(P, Module, CallInfo, P1) :- '$call_c_test'('Pl_Term_To_Goal_4'(P, Module, CallInfo, P1)). /* '$term_to_goal'(P, Module, CallInfo, P1) :- g_assign('$term_to_goal_module', Module), g_assign('$term_to_goal_info', CallInfo), '$term_to_goal1'(P, P1) , !. '$term_to_goal'(P, _, _, _) :- '$pl_err_type'(callable, P). '$term_to_goal1'(P, P1) :- var(P), !, g_read('$term_to_goal_call_info', CallInfo), g_read('$term_to_goal_module', Module), ( integer(CallInfo) -> % for call P1 = '$call_internal'(P, Module, CallInfo) ; atom(Module) -> P1 = call(Module:P) ; P1 = call(P) ). '$term_to_goal1'(Module:P, P1) :- !, g_read('$term_to_goal_module', SaveModule), g_assign('$term_to_goal_module', Module), '$term_to_goal1'(P, P1), g_assign('$term_to_goal_module', SaveModule). '$term_to_goal1'((P -> Q), (P1 -> Q1)) :- !, '$term_to_goal1'(P, P1), '$term_to_goal1'(Q, Q1). '$term_to_goal1'((P *-> Q), (P1 *-> Q1)) :- !, '$term_to_goal1'(P, P1), '$term_to_goal1'(Q, Q1). '$term_to_goal1'((P, Q), (P1, Q1)) :- !, '$term_to_goal1'(P, P1), '$term_to_goal1'(Q, Q1). '$term_to_goal1'((P ; Q), (P1 ; Q1)) :- !, '$term_to_goal1'(P, P1), '$term_to_goal1'(Q, Q1). '$term_to_goal1'(P, P) :- P = call(_), !. '$term_to_goal1'(P, P) :- P = catch(_, _, _), !. '$term_to_goal1'(P, P1) :- callable(P), g_read('$term_to_goal_module', Module), ( atom(Module) -> P1 = Module:P ; P1 = P ). */ '$check_list'(List) :- list(List), !. '$check_list'(List) :- list_or_partial_list(List), !, '$pl_err_instantiation'. '$check_list'(List) :- '$pl_err_type'(list, List). '$check_list_or_partial_list'(List) :- list_or_partial_list(List), !. '$check_list_or_partial_list'(List) :- '$pl_err_type'(list, List). '$check_atom_or_atom_list'(List) :- atom(List), !. '$check_atom_or_atom_list'(List) :- '$check_atom_or_atom_list1'(List), !. '$check_atom_or_atom_list1'(List) :- var(List), '$pl_err_instantiation'. '$check_atom_or_atom_list1'([]). '$check_atom_or_atom_list1'([X|List]) :- '$check_atom_or_atom_list2'(X), '$check_atom_or_atom_list1'(List). '$check_atom_or_atom_list1'(List) :- '$pl_err_type'(list, List). '$check_atom_or_atom_list2'(MX) :- '$strip_module_nonvar'(MX, _, X), % NB: also accepts module qualification atom(X), !. /* '$check_atom_or_atom_list2'(X) :- var(X), !, '$pl_err_instantiation'. %detected by '$strip_module_nonvar' */ '$check_atom_or_atom_list2'(X) :- '$pl_err_type'(atom, X). '$check_head'(H) :- var(H), !, '$pl_err_instantiation'. '$check_head'(H) :- ( callable(H) -> true ; '$pl_err_type'(callable, H) ). '$check_nonvar'(X) :- nonvar(X), !. '$check_nonvar'(_) :- '$pl_err_instantiation'. '$get_pred_indic'(PI, DefModule, Module, Func, Arity) :- '$call_c_test'('Pl_Get_Pred_Indic_5'(PI, DefModule, Module, Func, Arity)). '$get_pred_indic_var'(PI, DefModule, Module, Func, Arity) :- '$call_c_test'('Pl_Get_Pred_Indic_Var_5'(PI, DefModule, Module, Func, Arity)). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/term_supp.h����������������������������������������������������������������0000644�0001750�0001750�00000011345�13021324543�015472� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : term_supp.h * * Descr.: term support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef TERM_SUPP_FILE WamWord pl_pi_module_word; WamWord pl_pi_name_word; WamWord pl_pi_arity_word; int pl_calling_module; PlLong pl_glob_dico_var[MAX_VAR_IN_TERM]; /* a general purpose dico */ #else extern WamWord pl_pi_module_word; extern WamWord pl_pi_name_word; extern WamWord pl_pi_arity_word; extern int pl_calling_module; extern PlLong pl_glob_dico_var[]; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define Pl_Unset_Calling_Module() (pl_calling_module = -1) #define Pl_Set_Calling_Module(m) (pl_calling_module = (m)) PlLong Pl_Term_Compare(WamWord start_u_word, WamWord start_v_word); Bool Pl_Treat_Vars_Of_Term(WamWord start_word, Bool generic_var, Bool (*fct) ()); int Pl_List_Length(WamWord start_word); int Pl_Term_Size(WamWord start_word); void Pl_Copy_Term(WamWord *dst_adr, WamWord *src_adr); void Pl_Copy_Contiguous_Term(WamWord *dst_adr, WamWord *src_adr); Bool Pl_Acyclic_Term_1(WamWord start_word); WamWord Pl_Strip_Module(WamWord term_word, Bool accept_var, Bool raise_error, WamWord *goal_word); int Pl_Strip_Module_Top(WamWord start_word, Bool accept_var, Bool raise_error, WamWord *goal_word); WamWord Pl_Get_Pred_Indicator(WamWord pred_indic_word, Bool accept_var, int *func, int *arity); int Pl_Get_Pred_Indicator_Top(WamWord pred_indic_word, Bool accept_var, int *func, int *arity); WamWord Pl_Get_Head_And_Body(WamWord clause_word, WamWord *head_word, WamWord *body_word); int Pl_Get_Head_And_Body_Top(WamWord clause_word, WamWord *head_word, WamWord *body_word); WamWord Pl_Term_To_Goal(WamWord term_word, WamWord module_word, WamWord call_info_word); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/flag.pl��������������������������������������������������������������������0000644�0001750�0001750�00000011267�13021324543�014554� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : flag.pl * * Descr.: Prolog flag and system variable management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_flag'. set_prolog_flag(Flag, Value) :- set_bip_name(set_prolog_flag, 2), '$call_c_test'('Pl_Set_Prolog_Flag_2'(Flag, Value)). current_prolog_flag(Flag, Value) :- set_bip_name(current_prolog_flag, 2), '$call_c_test'('Pl_Current_Prolog_Flag_2'(Flag, Value)). '$current_prolog_flag_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Prolog_Flag_Alt_0'). '$sys_var_write'(Var, N) :- '$call_c'('Pl_Sys_Var_Write_2'(Var, N)). '$sys_var_read'(Var, N) :- '$call_c_test'('Pl_Sys_Var_Read_2'(Var, N)). '$sys_var_inc'(Var) :- '$call_c'('Pl_Sys_Var_Inc_1'(Var)). '$sys_var_dec'(Var) :- '$call_c'('Pl_Sys_Var_Dec_1'(Var)). '$sys_var_set_bit'(Var, Bit) :- '$call_c'('Pl_Sys_Var_Set_Bit_2'(Var, Bit)). '$sys_var_reset_bit'(Var, Bit) :- '$call_c'('Pl_Sys_Var_Reset_Bit_2'(Var, Bit)). '$sys_var_get_bit'(Var, Bit, Value) :- '$call_c_test'('Pl_Sys_Var_Get_Bit_3'(Var, Bit, Value)). '$sys_var_put'(Var, Term) :- '$call_c'('Pl_Sys_Var_Put_2'(Var, Term)). '$sys_var_get'(Var, Term) :- '$call_c_test'('Pl_Sys_Var_Get_2'(Var, Term)). '$get_current_B'(X) :- '$call_c'('Pl_Get_Current_B_1'(X)). '$set_current_B'(X) :- '$call_c'('Pl_Set_Current_B_1'(X)). write_pl_state_file(File) :- set_bip_name(write_pl_state_file, 1), '$call_c_test'('Pl_Write_Pl_State_File'(File)). read_pl_state_file(File) :- set_bip_name(read_pl_state_file, 1), '$call_c_test'('Pl_Read_Pl_State_File'(File)). argument_counter(N) :- set_bip_name(argument_counter, 1), '$call_c_test'('Pl_Argument_Counter_1'(N)). argument_value(I, A) :- set_bip_name(argument_value, 2), '$call_c_test'('Pl_Argument_Value_2'(I, A)). argument_list(List) :- set_bip_name(argument_list, 1), '$call_c_test'('Pl_Argument_List_1'(List)). environ(VarName, Value) :- set_bip_name(environ, 2), '$call_c_test'('Pl_Environ_2'(VarName, Value)). '$environ_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Environ_Alt_0'). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/type_inl_c.c���������������������������������������������������������������0000644�0001750�0001750�00000017562�13021324543�015603� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : type_inl_c.c * * Descr.: type testing (inline) management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /* Type tests */ #define Tag_Is_Var(t) (t == TAG_REF_MASK) #define Tag_Is_Nonvar(t) (!Tag_Is_Var(t)) #define Tag_Is_Atom(t) (t == TAG_ATM_MASK) #define Tag_Is_Integer(t) (t == TAG_INT_MASK) #define Tag_Is_Float(t) (t == TAG_FLT_MASK) #define Tag_Is_Number(t) (Tag_Is_Integer(t) || Tag_Is_Float(t)) #define Tag_Is_Atomic(t) (Tag_Is_Atom(t) || Tag_Is_Number(t)) #define Tag_Is_Compound(t) (t == TAG_STC_MASK || t == TAG_LST_MASK) #define Tag_Is_Callable(t) (Tag_Is_Atom(t) || Tag_Is_Compound(t)) #ifndef NO_USE_FD_SOLVER #define Tag_Is_Fd_Var(t) (t == TAG_FDV_MASK) #else #define Tag_Is_Fd_Var(t) (FALSE) #endif #define Tag_Is_Non_Fd_Var(t) (!Tag_Is_Fd_Var(t)) #define Tag_Is_Generic_Var(t) (Tag_Is_Var(t) || Tag_Is_Fd_Var(t)) #define Tag_Is_Non_Generic_Var(t) (!Tag_Is_Generic_Var(t)) #define Type_Test(test, x) \ WamWord word, tag_mask; \ DEREF(x, word, tag_mask); \ return test(tag_mask) Bool FC Pl_Blt_Var(WamWord x) { Type_Test(Tag_Is_Var, x); } Bool FC Pl_Blt_Non_Var(WamWord x) { Type_Test(Tag_Is_Nonvar, x); } Bool FC Pl_Blt_Atom(WamWord x) { Type_Test(Tag_Is_Atom, x); } Bool FC Pl_Blt_Integer(WamWord x) { Type_Test(Tag_Is_Integer, x); } Bool FC Pl_Blt_Float(WamWord x) { Type_Test(Tag_Is_Float, x); } Bool FC Pl_Blt_Number(WamWord x) { Type_Test(Tag_Is_Number, x); } Bool FC Pl_Blt_Atomic(WamWord x) { Type_Test(Tag_Is_Atomic, x); } Bool FC Pl_Blt_Compound(WamWord x) { Type_Test(Tag_Is_Compound, x); } Bool FC Pl_Blt_Callable(WamWord x) { Type_Test(Tag_Is_Callable, x); } Bool FC Pl_Blt_Fd_Var(WamWord x) { Type_Test(Tag_Is_Fd_Var, x); } Bool FC Pl_Blt_Non_Fd_Var(WamWord x) { Type_Test(Tag_Is_Non_Fd_Var, x); } Bool FC Pl_Blt_Generic_Var(WamWord x) { Type_Test(Tag_Is_Generic_Var, x); } Bool FC Pl_Blt_Non_Generic_Var(WamWord x) { Type_Test(Tag_Is_Non_Generic_Var, x); } /*-------------------------------------------------------------------------* * PL_BLT_GROUND * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Ground(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; int arity; terminal_rec: DEREF(start_word, word, tag_mask); if (Tag_Is_Generic_Var(tag_mask)) return FALSE; if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); if (!Pl_Blt_Ground(Car(adr))) return FALSE; start_word = Cdr(adr); goto terminal_rec; } if (tag_mask == TAG_STC_MASK) { adr = UnTag_LST(word); arity = Arity(adr); adr = &Arg(adr, 0); while(--arity > 0) { if (!Pl_Blt_Ground(*adr++)) return FALSE; } start_word = *adr; goto terminal_rec; } return TRUE; } /*-------------------------------------------------------------------------* * PL_BLT_LIST * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_List(WamWord start_word) { WamWord word, tag_mask; for (;;) { DEREF(start_word, word, tag_mask); if (word == NIL_WORD) return TRUE; if (tag_mask != TAG_LST_MASK) return FALSE; start_word = Cdr(UnTag_LST(word)); } } /*-------------------------------------------------------------------------* * PL_BLT_PARTIAL_LIST * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Partial_List(WamWord start_word) { WamWord word, tag_mask; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) return TRUE; if (tag_mask != TAG_LST_MASK) return FALSE; start_word = Cdr(UnTag_LST(word)); } } /*-------------------------------------------------------------------------* * PL_BLT_LIST_OR_PARTIAL_LIST * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_List_Or_Partial_List(WamWord start_word) { WamWord word, tag_mask; for (;;) { DEREF(start_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || word == NIL_WORD) return TRUE; if (tag_mask != TAG_LST_MASK) return FALSE; start_word = Cdr(UnTag_LST(word)); } } ����������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/src_rdr_c.c����������������������������������������������������������������0000644�0001750�0001750�00000121302�13021324543�015402� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : src_rdr_c.c * * Descr.: Prolog source file reader - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <errno.h> #include <string.h> #include "gp_config.h" #ifndef _WIN32 #include <unistd.h> #else #include <io.h> #endif #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define DO 0 #define UNDO 1 #define REREAD_MASK (1 << 16) #define REFLECT_EOF_MASK (1 << 17) #define UNDO_DIRECTIVES_MASK (1 << 18) /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef enum { OP, SET_PROLOG_FLAG, CHAR_CONVERSION } SRDirType; typedef struct sr_one_direct *PSROneDirect; typedef struct sr_one_direct { SRDirType type; /* directive type */ WamWord a[2][3]; /* arguments: a[DO][...] and a[UNDO][...] */ PSROneDirect next; /* forward link (or NULL if last) */ PSROneDirect prev; /* backward link (or NULL if first) */ } SROneDirect; typedef struct { SROneDirect *first; /* first directive or NULL */ SROneDirect *last; /* last directive or NULL */ } SRDirect; typedef struct sr_file *PSRFile; typedef struct sr_file { int atom_file_name; /* file name atom */ int stm; /* associated stream */ Bool reposition; /* is it repositionable ? */ char *tmp_path; /* tmp used for reread when !reposition */ int tmp_stm; /* stm of the tmp file */ PSRFile next; /* link to next file */ /* --- include stack information --- */ Bool eof_reached; /* is the EOF reached for this file ? */ int include_line; /* line # this file includes a child file */ PSRFile parent_file; /* link to the parent file (includer) */ } SRFile; typedef struct sr_module *PSRModule; typedef struct sr_module { int atom_module_name; /* module atom */ int i_atom_file_def; /* interface: file name of definition */ int i_line_def; /* interface: line # of definition */ int b_atom_file_def; /* body: file name of current body (or -1) */ int b_line_def; /* body: line # of current body */ SRDirect direct_lst; /* list of directives (interface + body) */ PSRModule next; /* next module */ } SRModule; typedef struct { Bool in_use; /* open ? */ Bool close_master_at_end; /* close master at sr_close/1 ? */ int mask; /* see src_rdr.pl */ SRFile *file_first; /* queue of all files - first */ SRFile *file_last; /* queue of all files - last */ SRFile *file_top; /* stack of open files (top = current) */ SRFile *next_to_reread; /* NULL: in pass 1 or no more to reread */ int cur_l1, cur_l2; /* position (lines) of last read term */ int char_count; /* nb chars read in processed files */ int line_count; /* nb lines read in processed files */ int error_count; /* nb of errors emitted */ int warning_count; /* nb of warnings emitted */ int out_sora_word; /* SorA for writing (or NOT_A_WAM_WORD) */ SRDirect direct_lst; /* list of directives */ SRModule *module_lst; /* list of defined modules */ SRModule *cur_module; /* NULL or current module */ Bool interface; /* in interface or body of current module */ } SRInf; /*---------------------------------* * Global Variables * *---------------------------------*/ static SRInf *sr_tbl = NULL; /* table (mallocated) */ static int sr_tbl_size = 0; /* allocated size */ static int sr_last_used = -1; /* last sr used */ static SRInf *cur_sr; /* the current sr entry used */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Common_Clean(SRInf *sr, Bool for_reread); static SRInf *Get_Descriptor(WamWord desc_word, Bool accept_none); static void Do_Directives(SRDirect *direct); static void Undo_Directives(SRDirect *direct); static void Exec_One_Directive(SROneDirect *o, int do_undo); static void Close_Current_Module(void); static StmInf *Write_Location(WamWord sora_word, WamWord list_word, int atom_file_name, int l1, int l2c); static void Write_Message_Text(StmInf *pstm, WamWord sora_word, WamWord type_word, WamWord format_word, WamWord args_word); /* from oper_c.c */ void Pl_Op_3(WamWord prec_word, WamWord specif_word, WamWord oper_word); /* form flag_c.c */ Bool Pl_Set_Prolog_Flag_2(WamWord flag_word, WamWord value_word); /* from read_c.c */ void Pl_Char_Conversion_2(WamWord in_char_word, WamWord out_char_word); /* from write_c.c */ void Pl_Write_2(WamWord sora_word, WamWord term_word); /* from format_c.c */ void Pl_Format_3(WamWord sora_word, WamWord format_word, WamWord args_word); #define Interf_Body(interf) ((interf) ? "module" : "body") #define SR_CURRENT_DESC_ALT X1_2473725F63757272656E745F64657363726970746F725F616C74 Prolog_Prototype(SR_CURRENT_DESC_ALT, 0); /* TODO: * - use a table of pointers SRInf *[] + Malloc + Free * - do not use a dup of !repositionable stream but * change the mirror before the read_term and restore after * ??????????????????????????????????????????????????????????????????????? */ /*-------------------------------------------------------------------------* * PL_SR_INIT_OPEN_2 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Init_Open_2(WamWord desc_word, WamWord out_sora_word) { SRInf *sr; int desc; if (sr_tbl == NULL) /* first allocation */ { sr_tbl_size = 8; sr_last_used = -1; sr_tbl = (SRInf *) Calloc(sr_tbl_size, sizeof(SRInf)); } for(desc = 0; desc < sr_tbl_size; desc++) if (!sr_tbl[desc].in_use) break; if (desc == sr_tbl_size) Pl_Extend_Array((char **) &sr_tbl, &sr_tbl_size, sizeof(SRInf), TRUE); if (desc > sr_last_used) sr_last_used = desc; sr = cur_sr = sr_tbl + desc; if (sr->file_top) /* to due a previous aborted sr_open/3 */ { Free(sr->file_top); sr->file_top = NULL; } sr->mask = SYS_VAR_OPTION_MASK; sr->file_first = NULL; sr->file_last = NULL; sr->next_to_reread = NULL; /* 1st read mode */ sr->cur_l1 = sr->cur_l2 = 0; sr->char_count = 0; sr->line_count = 0; sr->error_count = 0; sr->warning_count = 0; if (pl_sys_var[1]) { Pl_Get_Stream_Or_Alias(out_sora_word, STREAM_CHECK_VALID); sr->out_sora_word = out_sora_word; } else sr->out_sora_word = NOT_A_WAM_WORD; sr->direct_lst.first = NULL; sr->direct_lst.last = NULL; sr->module_lst = NULL; sr->cur_module = NULL; sr->interface = FALSE; Pl_Get_Integer(desc, desc_word); } /*-------------------------------------------------------------------------* * PL_SR_OPEN_FILE_2 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Open_File_2(WamWord file_name_word, WamWord from_stream_word) { SRInf *sr = cur_sr; int atom_file_name; int stm; SRFile *file; Bool from_stream = Pl_Rd_Boolean(from_stream_word); Bool master_file = (sr->file_top == NULL); StmInf *pstm, *pstm_tmp; if (sr->next_to_reread == NULL) { if (from_stream) { stm = Pl_Get_Stream_Or_Alias(file_name_word, STREAM_CHECK_INPUT); Pl_Check_Stream_Type(stm, TRUE, TRUE); atom_file_name = pl_stm_tbl[stm]->atom_file_name; } else { atom_file_name = Pl_Rd_Atom(file_name_word); if (strcmp(pl_atom_tbl[atom_file_name].name, "user") == 0) #if 0 stm = pl_stm_input; #else { stm = Pl_Add_Stream(0, (PlLong) 0, pl_stm_tbl[pl_stm_input]->prop, NULL, NULL, NULL, NULL, NULL, NULL, NULL); *pl_stm_tbl[stm] = *pl_stm_tbl[pl_stm_input]; } #endif else { stm = Pl_Add_Stream_For_Stdio_File(pl_atom_tbl[atom_file_name].name, STREAM_MODE_READ, TRUE); if (stm < 0) { if (errno == ENOENT || errno == ENOTDIR) Pl_Err_Existence(pl_existence_source_sink, file_name_word); else Pl_Err_Permission(pl_permission_operation_open, pl_permission_type_source_sink, file_name_word); } } } pstm = pl_stm_tbl[stm]; file = (SRFile *) Malloc(sizeof(SRFile)); file->atom_file_name = atom_file_name; file->stm = stm; file->reposition = pstm->prop.reposition; if (!file->reposition) { file->tmp_path = Pl_M_Tempnam(NULL, NULL); file->tmp_stm = Pl_Add_Stream_For_Stdio_File(file->tmp_path, STREAM_MODE_WRITE, TRUE); if (file->tmp_stm < 0) Pl_Fatal_Error("cannot create tmp file %s in %s:%d", file->tmp_path, __FILE__, __LINE__); /* try to be similar to original file */ pstm_tmp = pl_stm_tbl[file->tmp_stm]; pstm_tmp->atom_file_name = atom_file_name; pstm_tmp->prop.eof_action = pstm->prop.eof_action; if (pstm_tmp->prop.buffering != pstm->prop.buffering) { pstm_tmp->prop.buffering = pstm->prop.buffering; Pl_Stdio_Set_Buffering((FILE *) pstm_tmp->file, pstm_tmp->prop.buffering); } Pl_Add_Mirror_To_Stream(stm, file->tmp_stm); } else { file->tmp_path = NULL; file->tmp_stm = -1; } file->next = NULL; if (sr->file_first == NULL) sr->file_first = file; else sr->file_last->next = file; sr->file_last = file; } else file = sr->next_to_reread; file->eof_reached = FALSE; file->parent_file = sr->file_top; if (sr->file_top) sr->file_top->include_line = sr->cur_l1; sr->file_top = file; if (master_file) /* we see here the master file */ { sr->close_master_at_end = !from_stream; sr->in_use = TRUE; } } /*-------------------------------------------------------------------------* * PL_SR_CLOSE_1 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Close_1(WamWord desc_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); SRFile *file, *file1; file = sr->file_first; if (!sr->close_master_at_end && file->tmp_path == NULL) goto skip_first; do { Pl_Close_Stm(file->stm, TRUE); if (file->tmp_path) unlink(file->tmp_path); skip_first: file1 = file; file = file->next; Free(file1); } while(file); sr->file_top = NULL; Common_Clean(sr, FALSE); sr->in_use = FALSE; while(sr_last_used >= 0 && !sr_tbl[sr_last_used].in_use) sr_last_used--; } /*-------------------------------------------------------------------------* * COMMON_CLEAN * * * *-------------------------------------------------------------------------*/ static void Common_Clean(SRInf *sr, Bool for_reread) { SROneDirect *o, *o1; SRModule *m, *m1; if (for_reread || (sr->mask & UNDO_DIRECTIVES_MASK) != 0) { if (sr->cur_module) Undo_Directives(&sr->cur_module->direct_lst); Undo_Directives(&sr->direct_lst); } o = sr->direct_lst.first; while(o) { o1 = o; o = o->next; Free(o1); } m = sr->module_lst; while(m) { o = m->direct_lst.first; while(o) { o1 = o; o = o->next; Free(o1); } m1 = m; m = m->next; Free(m1); } if (for_reread) { sr->cur_l1 = sr->cur_l2 = 0; sr->char_count = 0; sr->line_count = 0; sr->error_count = 0; sr->warning_count = 0; sr->direct_lst.first = NULL; sr->direct_lst.last = NULL; sr->module_lst = NULL; sr->cur_module = NULL; sr->interface = FALSE; } } /*-------------------------------------------------------------------------* * PL_SR_NEW_PASS_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_New_Pass_1(WamWord desc_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); StmInf *pstm; SRFile *file; if ((sr->mask & REREAD_MASK) == 0) return FALSE; if (!sr->file_last->reposition && !sr->file_top->eof_reached) { pstm = pl_stm_tbl[sr->file_top->stm]; while(Pl_Stream_Getc(pstm) != EOF) /* read until EOF for mirror */ ; } sr->next_to_reread = sr->file_first->next; for(file = sr->file_first; file; file = file->next) { if (file->reposition) Pl_Stream_Set_Position(pl_stm_tbl[file->stm], SEEK_SET, 0, 0, 0, 0); else { if (file != sr->file_first || sr->close_master_at_end) Pl_Close_Stm(file->stm, TRUE); Pl_Close_Stm(file->tmp_stm, TRUE); /* close mirror file */ file->stm = Pl_Add_Stream_For_Stdio_File(file->tmp_path, STREAM_MODE_READ, TRUE); file->reposition = TRUE; } } sr->file_top = sr->file_first; sr->file_top->eof_reached = FALSE; Common_Clean(sr, TRUE); return TRUE; } /*-------------------------------------------------------------------------* * PL_SR_ADD_DIRECTIVE_7 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Add_Directive_7(WamWord type_word, WamWord d1_word, WamWord d2_word, WamWord d3_word, WamWord u1_word, WamWord u2_word, WamWord u3_word) { SRInf *sr = cur_sr; SRDirect *d; SROneDirect one, *o; WamWord word, tag_mask; if (sr->cur_module == NULL) d = &sr->direct_lst; else d = &(sr->cur_module->direct_lst); o = &one; o->type = Pl_Rd_Integer(type_word); DEREF(d1_word, word, tag_mask); o->a[0][0] = word; DEREF(d2_word, word, tag_mask); o->a[0][1] = word; DEREF(d3_word, word, tag_mask); o->a[0][2] = word; DEREF(u1_word, word, tag_mask); o->a[1][0] = word; DEREF(u2_word, word, tag_mask); o->a[1][1] = word; DEREF(u3_word, word, tag_mask); o->a[1][2] = word; o->next = NULL; o->prev = d->last; Exec_One_Directive(o, DO); /* if exec OK, allocate and add it in lst */ o = (SROneDirect *) Malloc(sizeof(SROneDirect)); *o = one; if (d->first == NULL) d->first = o; else d->last->next = o; d->last = o; } /*-------------------------------------------------------------------------* * DO_DIRECTIVES * * * *-------------------------------------------------------------------------*/ static void Do_Directives(SRDirect *direct) { SROneDirect *o; for (o = direct->first; o; o = o->next) Exec_One_Directive(o, DO); } /*-------------------------------------------------------------------------* * UNDO_DIRECTIVES * * * *-------------------------------------------------------------------------*/ static void Undo_Directives(SRDirect *direct) { SROneDirect *o; for (o = direct->last; o; o = o->prev) Exec_One_Directive(o, UNDO); } /*-------------------------------------------------------------------------* * EXEC_ONE_DIRECTIVE * * * *-------------------------------------------------------------------------*/ static void Exec_One_Directive(SROneDirect *o, int do_undo) { switch(o->type) { case OP: Pl_Op_3(o->a[do_undo][0], o->a[do_undo][1], o->a[do_undo][2]); break; case SET_PROLOG_FLAG: Pl_Set_Prolog_Flag_2(o->a[do_undo][0], o->a[do_undo][1]); break; case CHAR_CONVERSION: Pl_Char_Conversion_2(o->a[do_undo][0], o->a[do_undo][1]); break; } } /*-------------------------------------------------------------------------* * PL_SR_CHANGE_OPTIONS_0 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Change_Options_0(void) { SRInf *sr = cur_sr; int reread_mask = sr->mask & REREAD_MASK; sr->mask = (SYS_VAR_OPTION_MASK & (~REREAD_MASK)) | reread_mask; } /*-------------------------------------------------------------------------* * SR_GET_STM__FOR_READ_TERM_1 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Get_Stm_For_Read_Term_1(WamWord stm_word) { SRInf *sr = cur_sr; SRFile *file; for(;;) { file = sr->file_top; if (!file->eof_reached) break; /* a EOF is reached */ if (file->parent_file == NULL) break; sr->char_count += pl_stm_tbl[file->stm]->char_count; sr->line_count += pl_stm_tbl[file->stm]->line_count; sr->file_top = file->parent_file; } Pl_Get_Integer(sr->file_top->stm, stm_word); } /*-------------------------------------------------------------------------* * PL_SR_EOF_REACHED_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_EOF_Reached_1(WamWord err_word) { SRInf *sr = cur_sr; sr->file_top->eof_reached = TRUE; /* delay close at next read */ if (sr->file_top->parent_file == NULL) { if (sr->cur_module) { sprintf(pl_glob_buff, "end_%s(%s) not encoutered - assumed found", Interf_Body(sr->interface), pl_atom_tbl[sr->cur_module->atom_module_name].name); Close_Current_Module(); Pl_Un_String(pl_glob_buff, err_word); } return TRUE; /* always reflect EOF for master file */ } return (sr->mask & REFLECT_EOF_MASK); } /*-------------------------------------------------------------------------* * PL_SR_UPDATE_POSITION_0 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Update_Position_0(void) { SRInf *sr = cur_sr; sr->cur_l1 = pl_last_read_line; sr->cur_l2 = pl_stm_tbl[sr->file_top->stm]->line_count; if (pl_stm_tbl[sr->file_top->stm]->line_pos > 0) sr->cur_l2++; } /*-------------------------------------------------------------------------* * PL_SR_START_MODULE_3 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Start_Module_3(WamWord module_name_word, WamWord interface_word, WamWord err_word) { SRInf *sr = cur_sr; int atom_module_name = Pl_Rd_Atom_Check(module_name_word); Bool interface = Pl_Rd_Boolean(interface_word); SRModule *m; *pl_glob_buff = '\0'; for(m = sr->module_lst; m; m = m->next) if (m->atom_module_name == atom_module_name) break; if (m == NULL) { if (!interface) { sprintf(pl_glob_buff, "module(%s) not encoutered - interface assumed empty", pl_atom_tbl[atom_module_name].name); } m = (SRModule *) Malloc(sizeof(SRModule)); m->atom_module_name = atom_module_name; m->i_atom_file_def = sr->file_top->atom_file_name; m->i_line_def = sr->cur_l1; m->b_atom_file_def = -1; m->b_line_def = 0; m->direct_lst.first = NULL; m->direct_lst.last = NULL; m->next = sr->module_lst; sr->module_lst = m; } else { if (interface) { sprintf(pl_glob_buff, "module(%s) already found at %s:%d - directive ignored", pl_atom_tbl[atom_module_name].name, pl_atom_tbl[m->i_atom_file_def].name, m->i_line_def); goto error; } } if (sr->cur_module) { sprintf(pl_glob_buff, "end_%s(%s) not encoutered - assumed found", Interf_Body(sr->interface), pl_atom_tbl[sr->cur_module->atom_module_name].name); Close_Current_Module(); } if (!interface) { m->b_atom_file_def = sr->file_top->atom_file_name; m->b_line_def = sr->cur_l1; } sr->cur_module = m; sr->interface = interface; Do_Directives(&m->direct_lst); if (*pl_glob_buff) { error: Pl_Un_String(pl_glob_buff, err_word); } } /*-------------------------------------------------------------------------* * PL_SR_STOP_MODULE_3 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Stop_Module_3(WamWord module_name_word, WamWord interface_word, WamWord err_word) { SRInf *sr = cur_sr; int atom_module_name = Pl_Rd_Atom_Check(module_name_word); Bool interface = Pl_Rd_Boolean(interface_word); SRModule *m = sr->cur_module; *pl_glob_buff = '\0'; if (m == NULL) { sprintf(pl_glob_buff, "corresponding directive %s(%s) not found - directive ignored", Interf_Body(interface), pl_atom_tbl[atom_module_name].name); goto error; } if (interface != sr->interface || atom_module_name != m->atom_module_name) { sprintf(pl_glob_buff, "directive mismatch wrt %s:%d - replaced by end_%s(%s)", (sr->interface) ? pl_atom_tbl[m->i_atom_file_def].name : pl_atom_tbl[m->b_atom_file_def].name, (sr->interface) ? m->i_line_def : m->b_line_def, Interf_Body(sr->interface), pl_atom_tbl[m->atom_module_name].name); } Close_Current_Module(); if (*pl_glob_buff) { error: Pl_Un_String(pl_glob_buff, err_word); } } /*-------------------------------------------------------------------------* * CLOSE_CURRENT_MODULE * * * *-------------------------------------------------------------------------*/ static void Close_Current_Module(void) { SRInf *sr = cur_sr; Undo_Directives(&sr->cur_module->direct_lst); sr->cur_module = NULL; } /*-------------------------------------------------------------------------* * PL_SR_CURRENT_DESCRIPTOR_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Current_Descriptor_1(WamWord desc_word) { WamWord word, tag_mask; int desc = 0; DEREF(desc_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { desc = UnTag_INT(word); return (desc >= 0 && desc <= sr_last_used && sr_tbl[desc].in_use); } if (tag_mask != TAG_REF_MASK) Pl_Err_Type(pl_type_integer, word); for (; desc <= sr_last_used; desc++) if (sr_tbl[desc].in_use) break; if (desc >= sr_last_used) { if (desc > sr_last_used) return FALSE; } else /* non deterministic case */ { A(0) = desc_word; A(1) = desc + 1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(SR_CURRENT_DESC_ALT, 0), 2); } return Pl_Get_Integer(desc, desc_word); } /*-------------------------------------------------------------------------* * PL_SR_CURRENT_DESCRIPTOR_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Current_Descriptor_Alt_0(void) { WamWord desc_word; int desc; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(SR_CURRENT_DESC_ALT, 0), 0); desc_word = AB(B, 0); desc = AB(B, 1); for (; desc <= sr_last_used; desc++) if (sr_tbl[desc].in_use) break; if (desc >= sr_last_used) { Delete_Last_Choice_Point(); if (desc > sr_last_used) return FALSE; } else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = desc_word; #endif AB(B, 1) = desc + 1; } return Pl_Get_Integer(desc, desc_word); } /*-------------------------------------------------------------------------* * PL_SR_IS_BIT_SET_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Is_Bit_Set_1(WamWord bit_word) { return cur_sr->mask & (1 << Pl_Rd_Integer(bit_word)); } /*-------------------------------------------------------------------------* * PL_SR_GET_STM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Stm_2(WamWord desc_word, WamWord stm_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); return Pl_Get_Integer(sr->file_top->stm, stm_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_MODULE_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Module_3(WamWord desc_word, WamWord module_name_word, WamWord interface_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); SRModule *m = sr->cur_module; Pl_Check_For_Un_Atom(module_name_word); Pl_Check_For_Un_Atom(interface_word); if (m == NULL) return FALSE; if (!Pl_Get_Atom(m->atom_module_name, module_name_word)) return FALSE; if (sr->interface) return Pl_Un_String("interface", interface_word); return Pl_Un_String("body", interface_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_FILE_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_File_Name_2(WamWord desc_word, WamWord file_name_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); return Pl_Un_Atom_Check(sr->file_top->atom_file_name, file_name_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_POSITION_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Position_3(WamWord desc_word, WamWord l1_word, WamWord l2_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); Pl_Check_For_Un_Integer(l1_word); Pl_Check_For_Un_Integer(l2_word); return Pl_Get_Integer(sr->cur_l1, l1_word) && Pl_Get_Integer(sr->cur_l2, l2_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_INCLUDE_LIST_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Include_List_2(WamWord desc_word, WamWord list_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); SRFile *file; WamWord word; Pl_Check_For_Un_List(list_word); /* skip 1st file (current) */ for(file = sr->file_top->parent_file; file; file = file->parent_file) { word = Pl_Put_Structure(ATOM_CHAR(':'), 2); Pl_Unify_Atom(file->atom_file_name); Pl_Unify_Integer(file->include_line); if (!Pl_Get_List(list_word) || !Pl_Unify_Value(word)) return FALSE; list_word = Pl_Unify_Variable(); } return Pl_Get_Nil(list_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_INCLUDE_STREAM_LIST_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Include_Stream_List_2(WamWord desc_word, WamWord list_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); SRFile *file; WamWord word; Pl_Check_For_Un_List(list_word); /* skip 1st file (current) */ for(file = sr->file_top->parent_file; file; file = file->parent_file) { word = Pl_Put_Structure(pl_atom_stream, 1); Pl_Unify_Integer(file->stm); if (!Pl_Get_List(list_word) || !Pl_Unify_Value(word)) return FALSE; list_word = Pl_Unify_Variable(); } return Pl_Get_Nil(list_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_SIZE_COUNTERS_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Size_Counters_3(WamWord desc_word, WamWord chars_word, WamWord lines_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); SRFile *file; int char_count, line_count; Pl_Check_For_Un_Integer(chars_word); Pl_Check_For_Un_Integer(lines_word); char_count = sr->char_count; line_count = sr->line_count; for(file = sr->file_top; file; file = file->parent_file) { char_count += pl_stm_tbl[file->stm]->char_count; line_count += pl_stm_tbl[file->stm]->line_count; } return Pl_Get_Integer(char_count, chars_word) && Pl_Get_Integer(line_count, lines_word); } /*-------------------------------------------------------------------------* * PL_SR_GET_ERROR_COUNTERS_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_SR_Get_Error_Counters_3(WamWord desc_word, WamWord errors_word, WamWord warnings_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); Pl_Check_For_Un_Integer(errors_word); Pl_Check_For_Un_Integer(warnings_word); return Pl_Get_Integer(sr->error_count, errors_word) && Pl_Get_Integer(sr->warning_count, warnings_word); } /*-------------------------------------------------------------------------* * PL_SR_SET_ERROR_COUNTERS_3 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Set_Error_Counters_3(WamWord desc_word, WamWord errors_word, WamWord warnings_word) { SRInf *sr = Get_Descriptor(desc_word, FALSE); int errors = Pl_Rd_Integer_Check(errors_word); int warnings = Pl_Rd_Integer_Check(warnings_word); sr->error_count = errors; sr->warning_count = warnings; } /*-------------------------------------------------------------------------* * PL_SR_CHECK_DESCRIPTOR_1 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Check_Descriptor_1(WamWord desc_word) { Get_Descriptor(desc_word, FALSE); } /*-------------------------------------------------------------------------* * GET_DESCRIPTOR * * * *-------------------------------------------------------------------------*/ static SRInf * Get_Descriptor(WamWord desc_word, Bool accept_none) { WamWord word, tag_mask; int desc; int atom; if (accept_none) { DEREF(desc_word, word, tag_mask); atom = UnTag_ATM(word); if (tag_mask == TAG_ATM_MASK && strcmp(pl_atom_tbl[atom].name, "none") == 0) { cur_sr = NULL; return cur_sr; } } desc = Pl_Rd_Integer_Check(desc_word); if (desc < 0 || desc > sr_last_used || !sr_tbl[desc].in_use) Pl_Err_Existence(pl_existence_sr_descriptor, desc_word); cur_sr = sr_tbl + desc; SYS_VAR_OPTION_MASK = cur_sr->mask; return cur_sr; } /*-------------------------------------------------------------------------* * PL_SR_WRITE_MESSAGE_4 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Write_Message_4(WamWord desc_word, WamWord type_word, WamWord format_word, WamWord args_word) { SRInf *sr = Get_Descriptor(desc_word, TRUE); StmInf *pstm; int atom_file_name; int l1, l2c; WamWord sora_word; if (sr) { sora_word = sr->out_sora_word; atom_file_name = sr->file_top->atom_file_name; l1 = sr->cur_l1; l2c = sr->cur_l2; } else { sora_word = NOT_A_WAM_WORD; atom_file_name = pl_atom_void; l1 = 0; l2c = 0; } pstm = Write_Location(sora_word, NOT_A_WAM_WORD, atom_file_name, l1, l2c); Write_Message_Text(pstm, sora_word, type_word, format_word, args_word); } /*-------------------------------------------------------------------------* * PL_SR_WRITE_MESSAGE_6 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Write_Message_6(WamWord desc_word, WamWord l1_word, WamWord l2c_word, WamWord type_word, WamWord format_word, WamWord args_word) { SRInf *sr = Get_Descriptor(desc_word, TRUE); StmInf *pstm; int atom_file_name; int l1, l2c; WamWord sora_word; if (sr) { sora_word = sr->out_sora_word; atom_file_name = sr->file_top->atom_file_name; } else { sora_word = NOT_A_WAM_WORD; atom_file_name = pl_atom_void; } l1 = Pl_Rd_Integer_Check(l1_word); l2c = Pl_Rd_Integer_Check(l2c_word); pstm = Write_Location(sora_word, NOT_A_WAM_WORD, atom_file_name, l1, l2c); Write_Message_Text(pstm, sora_word, type_word, format_word, args_word); } /*-------------------------------------------------------------------------* * PL_SR_WRITE_MESSAGE_8 * * * *-------------------------------------------------------------------------*/ void Pl_SR_Write_Message_8(WamWord desc_word, WamWord list_word, WamWord file_name_word, WamWord l1_word, WamWord l2c_word, WamWord type_word, WamWord format_word, WamWord args_word) { SRInf *sr = Get_Descriptor(desc_word, TRUE); StmInf *pstm; int atom_file_name; int l1, l2c; WamWord sora_word; if (!Pl_Blt_List(list_word)) Pl_Err_Type(pl_type_list, list_word); if (sr) { sora_word = sr->out_sora_word; } else { sora_word = NOT_A_WAM_WORD; } sora_word = sr->out_sora_word; atom_file_name = Pl_Rd_Atom_Check(file_name_word); l1 = Pl_Rd_Integer_Check(l1_word); l2c = Pl_Rd_Integer_Check(l2c_word); pstm = Write_Location(sora_word, list_word, atom_file_name, l1, l2c); Write_Message_Text(pstm, sora_word, type_word, format_word, args_word); } /*-------------------------------------------------------------------------* * WRITE_LOCATION * * * *-------------------------------------------------------------------------*/ static StmInf * Write_Location(WamWord sora_word, WamWord list_word, int atom_file_name, int l1, int l2c) { WamWord word, tag_mask; int stm; StmInf *pstm; WamWord *lst_adr; Bool first; SRInf *sr = cur_sr; SRFile *file = NULL; int char_count; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pstm = pl_stm_tbl[stm]; pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); if (list_word == NOT_A_WAM_WORD && sr != NULL) file = sr->file_top->parent_file; for (first = TRUE; ; first = FALSE) { if (list_word != NOT_A_WAM_WORD) { DEREF(list_word, word, tag_mask); if (word == NIL_WORD) break; } else if (file == NULL) break; if (first) { if (pstm->line_pos != 0) Pl_Stream_Putc('\n', pstm); Pl_Stream_Puts("In file included from ", pstm); } else Pl_Stream_Printf(pstm, ",\n%*s from ", 16, ""); if (list_word != NOT_A_WAM_WORD) { lst_adr = UnTag_LST(word); /* accepts sora_word = NOT_A_WAM_WORD */ Pl_Write_2(sora_word, Car(lst_adr)); list_word = Cdr(lst_adr); } else { Pl_Stream_Printf(pstm, "%s:%d", pl_atom_tbl[file->atom_file_name].name, file->include_line); file = file->parent_file; } } if (!first) Pl_Stream_Puts(":\n", pstm); char_count = pstm->char_count; if (atom_file_name != pl_atom_void) Pl_Stream_Puts(pl_atom_tbl[atom_file_name].name, pstm); if (l1 > 0) { Pl_Stream_Printf(pstm, ":%d", l1); if (l2c != l1) { if (l2c > 0) Pl_Stream_Printf(pstm, "--%d", l2c); else Pl_Stream_Printf(pstm, ":%d", -l2c); } } if (char_count != pstm->char_count) Pl_Stream_Puts(": ", pstm); return pstm; } /*-------------------------------------------------------------------------* * WRITE_MESSAGE_TEXT * * * *-------------------------------------------------------------------------*/ static void Write_Message_Text(StmInf *pstm, WamWord sora_word, WamWord type_word, WamWord format_word, WamWord args_word) { SRInf *sr = cur_sr; char *type = Pl_Rd_String_Check(type_word); if (*type) { Pl_Stream_Printf(pstm, "%s: ", type); if (sr) { if (strstr(type, "error") || strstr(type, "exception")) sr->error_count++; else if (strstr(type, "warning")) sr->warning_count++; } } /* accepts sora_word = NOT_A_WAM_WORD */ Pl_Format_3(sora_word, format_word, args_word); } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pl_error.wam���������������������������������������������������������������0000644�0001750�0001750�00000006356�13021356407�015647� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : pl_error.pl file_name('/home/diaz/GP/src/BipsPl/pl_error.pl'). predicate(system:set_bip_name/2,42,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_2',[],[x(0),x(1)]), proceed]). predicate(system:current_bip_name/2,45,static,private,monofile,built_in,[ call_c('Pl_Current_Bip_Name_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$pl_err_instantiation'/0,51,static,private,monofile,built_in,[ put_atom(instantiation_error,0), execute('$pl_error'/1)]). predicate(system:'$pl_err_uninstantiation'/1,54,static,private,monofile,built_in,[ get_variable(x(1),0), put_structure(uninstantiation_error/1,0), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_type'/2,57,static,private,monofile,built_in,[ get_variable(x(2),0), put_structure(type_error/2,0), unify_local_value(x(2)), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_domain'/2,60,static,private,monofile,built_in,[ get_variable(x(2),0), put_structure(domain_error/2,0), unify_local_value(x(2)), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_existence'/2,63,static,private,monofile,built_in,[ get_variable(x(2),0), put_structure(existence_error/2,0), unify_local_value(x(2)), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_permission'/3,66,static,private,monofile,built_in,[ get_variable(x(3),0), put_structure(permission_error/3,0), unify_local_value(x(3)), unify_local_value(x(1)), unify_local_value(x(2)), execute('$pl_error'/1)]). predicate(system:'$pl_err_representation'/1,69,static,private,monofile,built_in,[ get_variable(x(1),0), put_structure(representation_error/1,0), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_evaluation'/1,72,static,private,monofile,built_in,[ get_variable(x(1),0), put_structure(evaluation_error/1,0), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_resource'/1,75,static,private,monofile,built_in,[ get_variable(x(1),0), put_structure(resource_error/1,0), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_syntax'/1,78,static,private,monofile,built_in,[ get_variable(x(1),0), put_structure(syntax_error/1,0), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_err_system'/1,81,static,private,monofile,built_in,[ get_variable(x(1),0), put_structure(system_error/1,0), unify_local_value(x(1)), execute('$pl_error'/1)]). predicate(system:'$pl_error'/1,88,static,private,monofile,built_in,[ get_variable(x(2),0), put_variable(x(1),0), call_c('Pl_Context_Error_1',[],[x(0)]), put_structure(error/2,0), unify_local_value(x(2)), unify_value(x(1)), put_atom(system,1), put_atom('$pl_error',2), put_integer(1,3), execute('$throw'/4)]). predicate(system:syntax_error_info/4,95,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[syntax_error_info,4]), call_c('Pl_Syntax_Error_Info_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/call.pl��������������������������������������������������������������������0000644�0001750�0001750�00000020532�13021324543�014551� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : call.pl * * Descr.: meta call management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_call'. :- meta_predicate(once(0)). once(Goal) :- call(Goal), !. :- meta_predicate(\+(0)). \+ Goal :- ( call(Goal) -> fail ; true ). :- meta_predicate(call_det(0, ?)). call_det(Goal, Deterministic) :- ( nonvar(Deterministic), Deterministic \== false, Deterministic \== true -> set_bip_name(call, 2), '$pl_err_type'(boolean, Deterministic) ; true ), '$get_current_B'(B), call(Goal), '$get_current_B'(B1), ( B1 > B -> Deterministic = false ; Deterministic = true ). /* Goal the goal to execute * Module is the lookup module for the Goal (i.e. Module:Goal) * (this is passed separately to avoid meta-arg creation) * CallerFunc/CallerArity: the pred/arity which invoked the call (head of the clause) * NB: add the CallerModule (as CallerMFA: Module/Func/Arity) also for catch/throw * for instance in module foo:p(X):- bar:call(X), the CallerMFA is foo:p/1 but Module is bar. * * To be fast a C function is first called: it mainly handles a call to a predicate * (and some simple control constructs). * * For more complex constructs it calls (via return) '$call_internal_xxx' predicates * It has set bip_name to CallerFunc/CallerArity. * The predicates containing '_internal' accept a CallInfo (which is dereferenced) */ '$call'(Goal, Module, CallerFunc, CallerArity) :- '$call_c'('Pl_BC_Call_5'(Goal, Module, CallerFunc, CallerArity, 1), [jump, by_value]). '$call_no_debug'(Goal, Module, CallerFunc, CallerArity) :- '$call_c'('Pl_BC_Call_5'(Goal, Module, CallerFunc, CallerArity, 0), [jump, by_value]). /* called by Pl_BC_Call_5 for control-constructs , ; -> *-> (all of arity = 2) */ '$call_internal_and'(P, Q, Module, CallInfo, VarCut) :- '$call_internal_with_cut'(P, Module, CallInfo, VarCut), '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). '$call_internal_if'(P, Q, Module, CallInfo, VarCut) :- !, '$call_internal'(P, Module, CallInfo), !, '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). % P *-> Q alone (i.e. not inside a ;) is logically the same as P, Q. % However a cut in the test part (P) should be local to P (as in P -> Q). '$call_internal_soft_if'(P, Q, Module, CallInfo, VarCut) :- !, '$call_internal'(P, Module, CallInfo), '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). /* call_internal / call_internal_with_cut */ '$call_internal'(Goal, Module, CallInfo) :- '$get_cut_level'(VarCut), % must be the first goal (A(arity)=cut) '$call_internal_with_cut'(Goal, Module, CallInfo, VarCut). % also called by C code BC_Emulate_Clause '$call_internal_with_cut'(Goal, _, CallInfo, _) :- var(Goal), !, '$call_c'('Pl_Call_Info_Bip_Name_1'(CallInfo)), '$pl_err_instantiation'. '$call_internal_with_cut'(Module:P, _, CallInfo, VarCut) :- !, '$call_internal_with_cut'(P, Module, CallInfo, VarCut). '$call_internal_with_cut'((P, Q), Module, CallInfo, VarCut) :- !, '$call_internal_with_cut'(P, Module, CallInfo, VarCut), '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). '$call_internal_with_cut'((P ; Q), Module, CallInfo, VarCut) :- !, '$call_internal_or'(P, Q, Module, CallInfo, VarCut). '$call_internal_with_cut'(!, _Module, _CallInfo, VarCut) :- % !, this cut is useless because '$cut'/1 '$cut'(VarCut). '$call_internal_with_cut'((P -> Q), Module, CallInfo, VarCut) :- !, '$call_internal'(P, Module, CallInfo), !, '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). % P *-> Q alone (i.e. not inside a ;) is logically the same as P, Q. % However a cut in the test part (P) should be local to P (as in P -> Q). '$call_internal_with_cut'((P *-> Q), Module, CallInfo, VarCut) :- !, '$call_internal'(P, Module, CallInfo), '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). '$call_internal_with_cut'(fail, _Module, _CallInfo, _VarCut) :- !, fail. '$call_internal_with_cut'(true, _Module, _CallInfo, _VarCut) :- !. '$call_internal_with_cut'(call(Goal), Module, CallInfo, _VarCut) :- !, '$call_internal'(Goal, Module, CallInfo). '$call_internal_with_cut'(catch(Goal, Catch, Recovery), Module, CallInfo, _VarCut) :- !, '$catch_internal'(Goal, Catch, Recovery, Module, CallInfo). '$call_internal_with_cut'(throw(Ball), Module, CallInfo, _VarCut) :- !, '$throw_internal'(Ball, Module, CallInfo). % FIXME what to do with Module in throw (for error report, this is not the good Module (should be CallerModule)) '$call_internal_with_cut'(P, Module, CallInfo, _VarCut) :- '$call_c_jump'('Pl_BC_Call_Terminal_Pred_4'(P, Module, CallInfo, 1)). '$call_internal_or'((P -> Q), R, Module, CallInfo, VarCut) :- !, ( '$call_internal'(P, Module, CallInfo), !, '$call_internal_with_cut'(Q, Module, CallInfo, VarCut) ; '$call_internal_with_cut'(R, Module, CallInfo, VarCut) ). '$call_internal_or'((P *-> Q), R, Module, CallInfo, VarCut) :- !, ( '$call_internal'(P, Module, CallInfo) *-> '$call_internal_with_cut'(Q, Module, CallInfo, VarCut) ; '$call_internal_with_cut'(R, Module, CallInfo, VarCut) ). '$call_internal_or'(P, _, Module, CallInfo, VarCut) :- '$call_internal_with_cut'(P, Module, CallInfo, VarCut). '$call_internal_or'(_, Q, Module, CallInfo, VarCut) :- '$call_internal_with_cut'(Q, Module, CallInfo, VarCut). '$call_from_debugger'(Goal, Module, CallInfo) :- '$call_c_jump'('Pl_BC_Call_Terminal_Pred_4'(Goal, Module, CallInfo, 0)). false :- fail. :- meta_predicate(forall(0, 0)). forall(Condition, Action) :- '$not'((Condition, '$not'(Action, forall, 2)), forall, 2). '$not'(Goal, Func, Arity) :- ( '$call'(Goal, user, Func, Arity) -> % user is OK since Goal is qualified (meta_predicate) fail ; true ). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/sort.pl��������������������������������������������������������������������0000644�0001750�0001750�00000007337�13021324543�014635� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : sort.pl * * Descr.: sort management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_sort'. sort(List1, List2) :- set_bip_name(sort, 2), '$sys_var_write'(0, 0), % 0 = sort '$call_c_test'('Pl_Sort_List_2'(List1, List2)). msort(List1, List2) :- set_bip_name(msort, 2), '$sys_var_write'(0, 1), % 1 = msort '$call_c_test'('Pl_Sort_List_2'(List1, List2)). keysort(List1, List2) :- set_bip_name(keysort, 2), '$sys_var_write'(0, 2), % 2 = keysort '$call_c_test'('Pl_Sort_List_2'(List1, List2)). % sort in-place predicates sort(List) :- set_bip_name(sort, 1), '$sys_var_write'(0, 0), % 0 = sort '$call_c'('Pl_Sort_List_1'(List)). msort(List) :- set_bip_name(msort, 1), '$sys_var_write'(0, 1), % 1 = msort '$call_c'('Pl_Sort_List_1'(List)). keysort(List) :- set_bip_name(keysort, 1), '$sys_var_write'(0, 2), % 2 = keysort '$call_c'('Pl_Sort_List_1'(List)). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/all_pl_bips.wam������������������������������������������������������������0000644�0001750�0001750�00000002231�13021356407�016267� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : all_pl_bips.pl file_name('/home/diaz/GP/src/BipsPl/all_pl_bips.pl'). predicate(system:'$use_all_pl_bips'/0,41,static,private,monofile,built_in,[ allocate(0), call('$use_control'/0), call('$use_call'/0), call('$use_call_args'/0), call('$use_catch'/0), call('$use_throw'/0), call('$use_unify'/0), call('$use_arith_inl'/0), call('$use_assert'/0), call('$use_all_solut'/0), call('$use_sort'/0), call('$use_list'/0), call('$use_stream'/0), call('$use_le_interf'/0), call('$use_file'/0), call('$use_char_io'/0), call('$use_read'/0), call('$use_write'/0), call('$use_print'/0), call('$use_const_io'/0), call('$use_oper'/0), call('$use_pred'/0), call('$use_atom'/0), call('$use_flag'/0), call('$use_term_inl'/0), call('$use_type_inl'/0), call('$use_g_var_inl'/0), call('$use_stat'/0), call('$use_dec10io'/0), call('$use_format'/0), call('$use_os_interf'/0), call('$use_expand'/0), call('$use_pretty'/0), call('$use_random'/0), call('$use_sockets'/0), deallocate, execute('$use_src_rdr'/0)]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/sockets.pl�����������������������������������������������������������������0000644�0001750�0001750�00000010475�13021324543�015316� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : sockets.pl * * Descr.: sockets management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_sockets'. socket(Domain, Socket) :- set_bip_name(socket, 2), '$call_c_test'('Pl_Socket_2'(Domain, Socket)). socket_close(Socket) :- set_bip_name(socket_close, 1), '$call_c_test'('Pl_Socket_Close_1'(Socket)). socket_bind(Socket, Address) :- set_bip_name(socket_bind, 2), '$call_c_test'('Pl_Socket_Bind_2'(Socket, Address)). socket_connect(Socket, Address, StreamIn, StreamOut) :- set_bip_name(socket_connect, 4), '$get_open_stm'(StreamIn, StmIn), '$get_open_stm'(StreamOut, StmOut), '$call_c_test'('Pl_Socket_Connect_4'(Socket, Address, StmIn, StmOut)). socket_listen(Socket, Length) :- set_bip_name(socket_listen, 2), '$call_c_test'('Pl_Socket_Listen_2'(Socket, Length)). socket_accept(Socket, StreamIn, StreamOut) :- set_bip_name(socket_accept, 3), '$get_open_stm'(StreamIn, StmIn), '$get_open_stm'(StreamOut, StmOut), '$call_c_test'('Pl_Socket_Accept_4'(Socket, _, StmIn, StmOut)). socket_accept(Socket, Client, StreamIn, StreamOut) :- set_bip_name(socket_accept, 4), ( var(Client) -> true ; '$pl_err_uninstantiation'(Client) ), '$get_open_stm'(StreamIn, StmIn), '$get_open_stm'(StreamOut, StmOut), '$call_c_test'('Pl_Socket_Accept_4'(Socket, Client, StmIn, StmOut)). '$assoc_socket_streams'(Socket, StreamIn, StreamOut) :- set_bip_name('$assoc_socket_streams', 3), '$get_open_stm'(StreamIn, StmIn), '$get_open_stm'(StreamOut, StmOut), '$call_c_test'('Pl_Assoc_Socket_Streams_3'(Socket, StmIn, StmOut)). hostname_address(HostName, HostAddress) :- set_bip_name(hostname_address, 2), '$call_c_test'('Pl_Hostname_Address_2'(HostName, HostAddress)). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/flag.wam�������������������������������������������������������������������0000644�0001750�0001750�00000007300�13021356407�014722� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : flag.pl file_name('/home/diaz/GP/src/BipsPl/flag.pl'). predicate(system:'$use_flag'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:set_prolog_flag/2,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_prolog_flag,2]), call_c('Pl_Set_Prolog_Flag_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:current_prolog_flag/2,51,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_prolog_flag,2]), call_c('Pl_Current_Prolog_Flag_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_prolog_flag_alt'/0,58,static,private,monofile,built_in,[ call_c('Pl_Current_Prolog_Flag_Alt_0',[boolean],[]), proceed]). predicate(system:'$sys_var_write'/2,64,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Write_2',[],[x(0),x(1)]), proceed]). predicate(system:'$sys_var_read'/2,67,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Read_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$sys_var_inc'/1,74,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Inc_1',[],[x(0)]), proceed]). predicate(system:'$sys_var_dec'/1,77,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Dec_1',[],[x(0)]), proceed]). predicate(system:'$sys_var_set_bit'/2,83,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Set_Bit_2',[],[x(0),x(1)]), proceed]). predicate(system:'$sys_var_reset_bit'/2,86,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Reset_Bit_2',[],[x(0),x(1)]), proceed]). predicate(system:'$sys_var_get_bit'/3,89,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Get_Bit_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$sys_var_put'/2,95,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Put_2',[],[x(0),x(1)]), proceed]). predicate(system:'$sys_var_get'/2,98,static,private,monofile,built_in,[ call_c('Pl_Sys_Var_Get_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$get_current_B'/1,104,static,private,monofile,built_in,[ call_c('Pl_Get_Current_B_1',[],[x(0)]), proceed]). predicate(system:'$set_current_B'/1,107,static,private,monofile,built_in,[ call_c('Pl_Set_Current_B_1',[],[x(0)]), proceed]). predicate(system:write_pl_state_file/1,113,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[write_pl_state_file,1]), call_c('Pl_Write_Pl_State_File',[boolean],[x(0)]), proceed]). predicate(system:read_pl_state_file/1,120,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_pl_state_file,1]), call_c('Pl_Read_Pl_State_File',[boolean],[x(0)]), proceed]). predicate(system:argument_counter/1,127,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[argument_counter,1]), call_c('Pl_Argument_Counter_1',[boolean],[x(0)]), proceed]). predicate(system:argument_value/2,134,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[argument_value,2]), call_c('Pl_Argument_Value_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:argument_list/1,141,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[argument_list,1]), call_c('Pl_Argument_List_1',[boolean],[x(0)]), proceed]). predicate(system:environ/2,146,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[environ,2]), call_c('Pl_Environ_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$environ_alt'/0,151,static,private,monofile,built_in,[ call_c('Pl_Environ_Alt_0',[boolean],[]), proceed]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/file.wam�������������������������������������������������������������������0000644�0001750�0001750�00000003051�13021356407�014727� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : file.pl file_name('/home/diaz/GP/src/BipsPl/file.pl'). predicate(system:'$use_file'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:absolute_file_name/2,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[absolute_file_name,2]), call_c('Pl_Absolute_File_Name_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:is_absolute_file_name/1,51,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is_absolute_file_name,1]), call_c('Pl_Is_Absolute_File_Name_1',[boolean],[x(0)]), proceed]). predicate(system:is_relative_file_name/1,58,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is_relative_file_name,1]), call_c('Pl_Is_Relative_File_Name_1',[boolean],[x(0)]), proceed]). predicate(system:decompose_file_name/4,65,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[decompose_file_name,4]), call_c('Pl_Decompose_File_Name_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:prolog_file_name/2,72,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[prolog_file_name,2]), call_c('Pl_Prolog_File_Name_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$prolog_file_suffix'/1,79,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[prolog_file_suffix,1]), call_c('Pl_Prolog_File_Suffix_1',[boolean],[x(0)]), proceed]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/inl_protos.h���������������������������������������������������������������0000644�0001750�0001750�00000022311�13021324543�015637� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : inl_protos.h * * Descr.: inline predicate prototypes - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /* from type_inl_c.c */ Bool FC Pl_Blt_Var(WamWord x); Bool FC Pl_Blt_Non_Var(WamWord x); Bool FC Pl_Blt_Atom(WamWord x); Bool FC Pl_Blt_Integer(WamWord x); Bool FC Pl_Blt_Float(WamWord x); Bool FC Pl_Blt_Number(WamWord x); Bool FC Pl_Blt_Atomic(WamWord x); Bool FC Pl_Blt_Compound(WamWord x); Bool FC Pl_Blt_Callable(WamWord x); Bool FC Pl_Blt_Ground(WamWord x); Bool FC Pl_Blt_Fd_Var(WamWord x); Bool FC Pl_Blt_Non_Fd_Var(WamWord x); Bool FC Pl_Blt_Generic_Var(WamWord x); Bool FC Pl_Blt_Non_Generic_Var(WamWord x); Bool FC Pl_Blt_List(WamWord x); Bool FC Pl_Blt_Partial_List(WamWord x); Bool FC Pl_Blt_List_Or_Partial_List(WamWord x); /* from term_inl_c.c */ Bool FC Pl_Blt_Term_Eq(WamWord x, WamWord y); Bool FC Pl_Blt_Term_Neq(WamWord x, WamWord y); Bool FC Pl_Blt_Term_Lt(WamWord x, WamWord y); Bool FC Pl_Blt_Term_Lte(WamWord x, WamWord y); Bool FC Pl_Blt_Term_Gt(WamWord x, WamWord y); Bool FC Pl_Blt_Term_Gte(WamWord x, WamWord y); Bool FC Pl_Blt_Compare(WamWord cmp_word, WamWord x, WamWord y); Bool FC Pl_Blt_Arg(WamWord arg_no_word, WamWord term_word, WamWord sub_term_word); Bool FC Pl_Blt_Functor(WamWord term_word, WamWord functor_word, WamWord arity_word); Bool FC Pl_Blt_Univ(WamWord term_word, WamWord list_word); /* from g_var_inl_c.c */ void FC Pl_Blt_G_Assign(WamWord x, WamWord y); void FC Pl_Blt_G_Assignb(WamWord x, WamWord y); void FC Pl_Blt_G_Link(WamWord x, WamWord y); Bool FC Pl_Blt_G_Read(WamWord x, WamWord y); Bool FC Pl_Blt_G_Array_Size(WamWord x, WamWord y); void FC Pl_Blt_G_Inc(WamWord x); Bool FC Pl_Blt_G_Inco(WamWord x, WamWord y); Bool FC Pl_Blt_G_Inc_2(WamWord x, WamWord y); Bool FC Pl_Blt_G_Inc_3(WamWord x, WamWord y, WamWord z); void FC Pl_Blt_G_Dec(WamWord x); Bool FC Pl_Blt_G_Deco(WamWord x, WamWord y); Bool FC Pl_Blt_G_Dec_2(WamWord x, WamWord y); Bool FC Pl_Blt_G_Dec_3(WamWord x, WamWord y, WamWord z); void FC Pl_Blt_G_Set_Bit(WamWord x, WamWord y); void FC Pl_Blt_G_Reset_Bit(WamWord x, WamWord y); Bool FC Pl_Blt_G_Test_Set_Bit(WamWord x, WamWord y); Bool FC Pl_Blt_G_Test_Reset_Bit(WamWord x, WamWord y); /* from arith_inl_c.c */ void FC Pl_Math_Fast_Load_Value(WamWord start_word, WamWord *word_adr); void FC Pl_Math_Load_Value(WamWord start_word, WamWord *word_adr); WamWord FC Pl_Fct_Fast_Neg(WamWord x); WamWord FC Pl_Fct_Fast_Inc(WamWord x); WamWord FC Pl_Fct_Fast_Dec(WamWord x); WamWord FC Pl_Fct_Fast_Add(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Sub(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Mul(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Div(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Rem(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Mod(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Div2(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_And(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Or(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Xor(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Not(WamWord x); WamWord FC Pl_Fct_Fast_Shl(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_Shr(WamWord x, WamWord y); WamWord FC Pl_Fct_Fast_LSB(WamWord x); WamWord FC Pl_Fct_Fast_MSB(WamWord x); WamWord FC Pl_Fct_Fast_Popcount(WamWord x); WamWord FC Pl_Fct_Fast_Abs(WamWord x); WamWord FC Pl_Fct_Fast_Sign(WamWord x); WamWord FC Pl_Fct_Fast_GCD(WamWord b, WamWord x); WamWord FC Pl_Fct_Fast_Log_Radix(WamWord b, WamWord x); WamWord FC Pl_Fct_Neg(WamWord x); WamWord FC Pl_Fct_Inc(WamWord x); WamWord FC Pl_Fct_Dec(WamWord x); WamWord FC Pl_Fct_Add(WamWord x, WamWord y); WamWord FC Pl_Fct_Sub(WamWord x, WamWord y); WamWord FC Pl_Fct_Mul(WamWord x, WamWord y); WamWord FC Pl_Fct_Div(WamWord x, WamWord y); WamWord FC Pl_Fct_Float_Div(WamWord x, WamWord y); WamWord FC Pl_Fct_Rem(WamWord x, WamWord y); WamWord FC Pl_Fct_Mod(WamWord x, WamWord y); WamWord FC Pl_Fct_Div2(WamWord x, WamWord y); WamWord FC Pl_Fct_And(WamWord x, WamWord y); WamWord FC Pl_Fct_Or(WamWord x, WamWord y); WamWord FC Pl_Fct_Xor(WamWord x, WamWord y); WamWord FC Pl_Fct_Not(WamWord x); WamWord FC Pl_Fct_Shl(WamWord x, WamWord y); WamWord FC Pl_Fct_Shr(WamWord x, WamWord y); WamWord FC Pl_Fct_Abs(WamWord x); WamWord FC Pl_Fct_LSB(WamWord x); WamWord FC Pl_Fct_MSB(WamWord x); WamWord FC Pl_Fct_Popcount(WamWord x); WamWord FC Pl_Fct_Sign(WamWord x); WamWord FC Pl_Fct_GCD(WamWord x, WamWord y); WamWord FC Pl_Fct_Min(WamWord x, WamWord y); WamWord FC Pl_Fct_Max(WamWord x, WamWord y); WamWord FC Pl_Fct_Integer_Pow(WamWord x, WamWord y); WamWord FC Pl_Fct_Pow(WamWord x, WamWord y); WamWord FC Pl_Fct_Sqrt(WamWord x); WamWord FC Pl_Fct_Tan(WamWord x); WamWord FC Pl_Fct_Atan(WamWord x); WamWord FC Pl_Fct_Atan2(WamWord x, WamWord y); WamWord FC Pl_Fct_Cos(WamWord x); WamWord FC Pl_Fct_Acos(WamWord x); WamWord FC Pl_Fct_Sin(WamWord x); WamWord FC Pl_Fct_Asin(WamWord x); WamWord FC Pl_Fct_Tanh(WamWord x); WamWord FC Pl_Fct_Atanh(WamWord x); WamWord FC Pl_Fct_Cosh(WamWord x); WamWord FC Pl_Fct_Acosh(WamWord x); WamWord FC Pl_Fct_Sinh(WamWord x); WamWord FC Pl_Fct_Asinh(WamWord x); WamWord FC Pl_Fct_Exp(WamWord x); WamWord FC Pl_Fct_Log(WamWord x); WamWord FC Pl_Fct_Log10(WamWord x); WamWord FC Pl_Fct_Log_Radix(WamWord b, WamWord x); WamWord FC Pl_Fct_Float(WamWord x); WamWord FC Pl_Fct_Ceiling(WamWord x); WamWord FC Pl_Fct_Floor(WamWord x); WamWord FC Pl_Fct_Round(WamWord x); WamWord FC Pl_Fct_Truncate(WamWord x); WamWord FC Pl_Fct_Float_Fract_Part(WamWord x); WamWord FC Pl_Fct_Float_Integ_Part(WamWord x); WamWord FC Pl_Fct_Identity(WamWord x); WamWord FC Pl_Fct_PI(void); WamWord FC Pl_Fct_E(void); WamWord FC Pl_Fct_Epsilon(void); Bool FC Pl_Blt_Fast_Eq(WamWord x, WamWord y); Bool FC Pl_Blt_Fast_Neq(WamWord x, WamWord y); Bool FC Pl_Blt_Fast_Lt(WamWord x, WamWord y); Bool FC Pl_Blt_Fast_Lte(WamWord x, WamWord y); Bool FC Pl_Blt_Fast_Gt(WamWord x, WamWord y); Bool FC Pl_Blt_Fast_Gte(WamWord x, WamWord y); Bool FC Pl_Blt_Eq(WamWord x, WamWord y); Bool FC Pl_Blt_Neq(WamWord x, WamWord y); Bool FC Pl_Blt_Lt(WamWord x, WamWord y); Bool FC Pl_Blt_Lte(WamWord x, WamWord y); Bool FC Pl_Blt_Gt(WamWord x, WamWord y); Bool FC Pl_Blt_Gte(WamWord x, WamWord y); �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/arith_inl.wam��������������������������������������������������������������0000644�0001750�0001750�00000004277�13021356407�015774� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : arith_inl.pl file_name('/home/diaz/GP/src/BipsPl/arith_inl.pl'). predicate(system:'$use_arith_inl'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:(is)/2,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(1),1), get_value(x(0),1), proceed]). predicate(system:(=:=)/2,47,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[=:=,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Eq',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(=\=)/2,50,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[=\=,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Neq',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(<)/2,53,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[<,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Lt',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(=<)/2,56,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[=<,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Lte',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(>)/2,59,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Gt',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:(>=)/2,62,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>=,2]), math_load_value(x(0),0), math_load_value(x(1),1), call_c('Pl_Blt_Gte',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:'$arith_eval'/2,66,static,private,monofile,built_in,[ call_c('Pl_Arith_Eval_2',[],[x(0),x(1)]), proceed]). predicate(system:succ/2,70,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[succ,2]), call_c('Pl_Succ_2',[boolean],[x(0),x(1)]), proceed]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/call_args.pl���������������������������������������������������������������0000644�0001750�0001750�00000014026�13021324543�015566� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : call_args.pl * * Descr.: meta call management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_call_args'. :- meta_predicate(call_with_args(1)). :- meta_predicate(call_with_args(1, ?)). :- meta_predicate(call_with_args(2, ?, ?)). :- meta_predicate(call_with_args(3, ?, ?, ?)). :- meta_predicate(call_with_args(4, ?, ?, ?, ?)). :- meta_predicate(call_with_args(5, ?, ?, ?, ?, ?)). :- meta_predicate(call_with_args(6, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call_with_args(7, ?, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call_with_args(8, ?, ?, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call_with_args(9, ?, ?, ?, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call_with_args(10, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)). call_with_args(_F) :- '$call_c'('Pl_Call_Closure'(call_with_args, 0), [jump, by_value]). call_with_args(_F, _A1) :- '$call_c'('Pl_Call_Closure'(call_with_args, 1), [jump, by_value]). call_with_args(_F, _A1, _A2) :- '$call_c'('Pl_Call_Closure'(call_with_args, 2), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3) :- '$call_c'('Pl_Call_Closure'(call_with_args, 3), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4) :- '$call_c'('Pl_Call_Closure'(call_with_args, 4), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4, _A5) :- '$call_c'('Pl_Call_Closure'(call_with_args, 5), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4, _A5, _A6) :- '$call_c'('Pl_Call_Closure'(call_with_args, 6), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4, _A5, _A6, _A7) :- '$call_c'('Pl_Call_Closure'(call_with_args, 7), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8) :- '$call_c'('Pl_Call_Closure'(call_with_args, 8), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8, _A9) :- '$call_c'('Pl_Call_Closure'(call_with_args, 9), [jump, by_value]). call_with_args(_F, _A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8, _A9, _A10) :- '$call_c'('Pl_Call_Closure'(call_with_args, 10), [jump, by_value]). :- meta_predicate(call(1, ?)). :- meta_predicate(call(2, ?, ?)). :- meta_predicate(call(3, ?, ?, ?)). :- meta_predicate(call(4, ?, ?, ?, ?)). :- meta_predicate(call(5, ?, ?, ?, ?, ?)). :- meta_predicate(call(6, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call(7, ?, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call(8, ?, ?, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call(9, ?, ?, ?, ?, ?, ?, ?, ?, ?)). :- meta_predicate(call(10, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)). call(_Closure, _A1) :- '$call_c'('Pl_Call_Closure'(call, 1), [jump, by_value]). call(_Closure, _A1, _A2) :- '$call_c'('Pl_Call_Closure'(call, 2), [jump, by_value]). call(_Closure, _A1, _A2, _A3) :- '$call_c'('Pl_Call_Closure'(call, 3), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4) :- '$call_c'('Pl_Call_Closure'(call, 4), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4, _A5) :- '$call_c'('Pl_Call_Closure'(call, 5), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4, _A5, _A6) :- '$call_c'('Pl_Call_Closure'(call, 6), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4, _A5, _A6, _A7) :- '$call_c'('Pl_Call_Closure'(call, 7), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8) :- '$call_c'('Pl_Call_Closure'(call, 8), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8, _A9) :- '$call_c'('Pl_Call_Closure'(call, 9), [jump, by_value]). call(_Closure, _A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8, _A9, _A10) :- '$call_c'('Pl_Call_Closure'(call, 10), [jump, by_value]). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/os_interf.pl���������������������������������������������������������������0000644�0001750�0001750�00000021431�13021324543�015625� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : os_interf.pl * * Descr.: operating system interface management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_os_interf'. make_directory(PathName) :- set_bip_name(make_directory, 1), '$call_c_test'('Pl_Make_Directory_1'(PathName)). delete_directory(PathName) :- set_bip_name(delete_directory, 2), '$call_c_test'('Pl_Delete_Directory_1'(PathName)). working_directory(Path) :- set_bip_name(working_directory, 1), '$call_c_test'('Pl_Working_Directory_1'(Path)). change_directory(Path) :- set_bip_name(change_directory, 1), '$call_c_test'('Pl_Change_Directory_1'(Path)). directory_files(PathName, List) :- set_bip_name(directory_files, 2), '$call_c_test'('Pl_Directory_Files_2'(PathName, List)). rename_file(PathName1, PathName2) :- set_bip_name(rename_file, 2), '$call_c_test'('Pl_Rename_File_2'(PathName1, PathName2)). unlink(PathName) :- set_bip_name(unlink, 2), '$call_c'('Pl_Unlink_1'(PathName)). delete_file(PathName) :- set_bip_name(delete_file, 2), '$call_c_test'('Pl_Delete_File_1'(PathName)). file_exists(PathName) :- set_bip_name(file_exists, 1), '$call_c_test'('Pl_File_Exists_1'(PathName)). file_permission(PathName, PermList) :- set_bip_name(file_permission, 2), '$call_c_test'('Pl_File_Permission_2'(PathName, PermList)). file_property(PathName, Property) :- set_bip_name(file_property, 2), '$check_file_prop'(Property), !, '$file_prop'(Property, PathName). '$check_file_prop'(Property) :- var(Property). '$check_file_prop'(absolute_file_name(_)). '$check_file_prop'(real_file_name(_)). '$check_file_prop'(type(_)). '$check_file_prop'(size(_)). '$check_file_prop'(permission(_)). '$check_file_prop'(creation(_)). '$check_file_prop'(last_access(_)). '$check_file_prop'(last_modification(_)). '$check_file_prop'(Property) :- '$pl_err_domain'(os_file_property, Property). '$file_prop'(absolute_file_name(AbsolutePathName), PathName) :- '$call_c_test'('Pl_File_Prop_Absolute_File_Name_2'(AbsolutePathName, PathName)). '$file_prop'(real_file_name(RealPathName), PathName) :- '$call_c_test'('Pl_File_Prop_Real_File_Name_2'(RealPathName, PathName)). '$file_prop'(type(Type), PathName) :- '$call_c_test'('Pl_File_Prop_Type_2'(Type, PathName)). '$file_prop'(size(Size), PathName) :- '$call_c_test'('Pl_File_Prop_Size_2'(Size, PathName)). '$file_prop'(permission(Perm), PathName) :- '$call_c_test'('Pl_Check_Prop_Perm_And_File_2'(Perm, PathName)), '$file_prop_perm'(Perm, PathName). '$file_prop'(creation(DateTime), PathName) :- '$sys_var_write'(0, 0), '$call_c_test'('Pl_File_Prop_Date_2'(DateTime, PathName)). '$file_prop'(last_access(DateTime), PathName) :- '$sys_var_write'(0, 1), '$call_c_test'('Pl_File_Prop_Date_2'(DateTime, PathName)). '$file_prop'(last_modification(DateTime), PathName) :- '$sys_var_write'(0, 2), '$call_c_test'('Pl_File_Prop_Date_2'(DateTime, PathName)). '$file_prop_perm'(read, PathName) :- file_permission(PathName, read). '$file_prop_perm'(write, PathName) :- file_permission(PathName, write). '$file_prop_perm'(execute, PathName) :- file_permission(PathName, execute). '$file_prop_perm'(search, PathName) :- file_permission(PathName, search). temporary_name(Template, PathName) :- set_bip_name(temporary_name, 2), '$call_c_test'('Pl_Temporary_Name_2'(Template, PathName)). temporary_file(Dir, Prefix, PathName) :- set_bip_name(temporary_file, 3), '$call_c_test'('Pl_Temporary_File_3'(Dir, Prefix, PathName)). date_time(DateTime) :- set_bip_name(date_time, 1), '$call_c_test'('Pl_Date_Time_1'(DateTime)). host_name(HostName) :- set_bip_name(host_name, 1), '$call_c_test'('Pl_Host_Name_1'(HostName)). os_version(OsVersion) :- set_bip_name(os_version, 1), '$call_c_test'('Pl_Os_Version_1'(OsVersion)). architecture(Architecture) :- set_bip_name(architecture, 1), '$call_c_test'('Pl_Architecture_1'(Architecture)). shell :- set_bip_name(shell, 0), '$call_c_test'('Pl_Shell_2'('', 0)). shell(Cmd) :- set_bip_name(shell, 1), '$call_c_test'('Pl_Shell_2'(Cmd, 0)). shell(Cmd, Status) :- set_bip_name(shell, 2), '$call_c_test'('Pl_Shell_2'(Cmd, Status)). system(Cmd) :- set_bip_name(system, 1), '$call_c_test'('Pl_System_2'(Cmd, 0)). system(Cmd, Status) :- set_bip_name(system, 2), '$call_c_test'('Pl_System_2'(Cmd, Status)). spawn(Cmd, LArg) :- set_bip_name(spawn, 2), '$call_c_test'('Pl_Spawn_3'(Cmd, LArg, 0)). spawn(Cmd, LArg, Status) :- set_bip_name(spawn, 3), '$call_c_test'('Pl_Spawn_3'(Cmd, LArg, Status)). sleep(Seconds) :- set_bip_name(sleep, 1), '$call_c'('Pl_Sleep_1'(Seconds)). popen(Cmd, Mode, Stream) :- set_bip_name(popen, 3), '$get_open_stm'(Stream, Stm), '$call_c_test'('Pl_Popen_3'(Cmd, Mode, Stm)). % exec mask in sys_var[0]: % b0 % 0/1 % Pid used exec(Cmd, StreamIn, StreamOut, StreamErr, Pid) :- set_bip_name(exec, 5), ( nonvar(Pid) -> '$pl_err_uninstantiation'(Pid) ; true ), '$sys_var_write'(0, 0), '$sys_var_set_bit'(0, 0), '$exec'(Cmd, StreamIn, StreamOut, StreamErr, Pid). exec(Cmd, StreamIn, StreamOut, StreamErr) :- set_bip_name(exec, 4), '$sys_var_write'(0, 0), '$exec'(Cmd, StreamIn, StreamOut, StreamErr, 0). '$exec'(Cmd, StreamIn, StreamOut, StreamErr, Pid) :- '$get_open_stm'(StreamIn, StmIn), '$get_open_stm'(StreamOut, StmOut), '$get_open_stm'(StreamErr, StmErr), '$call_c_test'('Pl_Exec_5'(Cmd, StmIn, StmOut, StmErr, Pid)). create_pipe(StreamIn, StreamOut) :- set_bip_name(create_pipe, 2), '$get_open_stm'(StreamIn, StmIn), '$get_open_stm'(StreamOut, StmOut), '$call_c_test'('Pl_Create_Pipe_2'(StmIn, StmOut)). fork_prolog(Pid) :- set_bip_name(fork_prolog, 1), ( nonvar(Pid) -> '$pl_err_uninstantiation'(Pid) ; true ), '$call_c_test'('Pl_Fork_Prolog_1'(Pid)). select(Reads, ReadyReads, Writes, ReadyWrites, TimeOut) :- set_bip_name(select, 5), '$call_c_test'('Pl_Select_5'(Reads, ReadyReads, Writes, ReadyWrites, TimeOut)). prolog_pid(PrologPid) :- set_bip_name(prolog_pid, 1), '$call_c_test'('Pl_Prolog_Pid_1'(PrologPid)). send_signal(Pid, Signal) :- set_bip_name(send_signal, 2), '$call_c_test'('Pl_Send_Signal_2'(Pid, Signal)). wait(Pid, Status) :- set_bip_name(wait, 2), '$call_c_test'('Pl_Wait_2'(Pid, Status)). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/all_pl_bips.pl�������������������������������������������������������������0000644�0001750�0001750�00000006541�13021324543�016122� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : all_pl_bips.pl * * Descr.: all bips (to force the linker) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. %to put the $use_all_pl_bips in module system '$use_all_pl_bips' :- '$use_control', '$use_call', '$use_call_args', '$use_catch', '$use_throw', '$use_unify', '$use_arith_inl', '$use_assert', '$use_all_solut', '$use_sort', '$use_list', '$use_stream', '$use_le_interf', '$use_file', '$use_char_io', '$use_read', '$use_write', '$use_print', '$use_const_io', '$use_oper', '$use_pred', '$use_atom', '$use_flag', '$use_term_inl', '$use_type_inl', '$use_g_var_inl', '$use_stat', '$use_dec10io', '$use_format', '$use_os_interf', '$use_expand', '$use_pretty', '$use_random', '$use_sockets', '$use_src_rdr'. ���������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/callinf_supp.h�������������������������������������������������������������0000644�0001750�0001750�00000006563�13021324543�016141� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : callinf_supp.h * * Descr.: meta call info support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Call_Info_Bip_Name_1(WamWord call_info_word); PlLong Pl_Make_Call_Info(WamWord func_word, WamWord arity_word, WamWord debug_call_word); #define Call_Info(f, a, dc) ((Functor_Arity(f, a) << 1) | dc) ���������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/flag_supp.c����������������������������������������������������������������0000644�0001750�0001750�00000043547�13021324543�015440� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : flag_supp.c * * Descr.: Prolog flag and system variable support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include "engine_pl.h" #include "gprolog_cst.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define NB_OF_FLAGS 64 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static FlagInf flag_tbl[NB_OF_FLAGS]; static int nb_flag; static int atom_on; static int atom_off; /* pl_atom_error is already defined in stream_supp.[ch] */ static int atom_warning; static int atom_fail; static int atom_chars; static int atom_codes; static int atom_atom; static int atom_chars_no_escape; static int atom_codes_no_escape; static int atom_atom_no_escape; static int atom_toward_zero; static int atom_down; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static FlagInf *Prolog_Flag_Lookup(int atom_name); #define CURRENT_PROLOG_FLAG_ALT X1_2463757272656E745F70726F6C6F675F666C61675F616C74 Prolog_Prototype(CURRENT_PROLOG_FLAG_ALT, 0); /*-------------------------------------------------------------------------* * Prolog flag support * * * * Since 1.4.4 Prolog flags are handled in a more general way in order to * * simplify the addition of new flags. * * A flag has the following attributes (see flag_supp.h) : * * - a name (string -> atom), * * - is modifiable or not (ro), * * - a type (several predefined types + 'any' for customization) * * - a value (a PlLong) used for predefined types and available for 'any'* * - a function get: used by current_prolog_flag * * - a function chk: used by set_prolog_flag (even if not modifiable) * * - a function set: used by set_prolog_flag (only if modifiable) * * * * The function chk is used by set_prolog_flag to check if the value is * * compatible with the flag even if the flag is read-only. If the function * * fails a domain_error is raised (if it succeeds and the flag is read-only* * the a permission_error will be raised). * * * * For some flags it is not clear what to test. E.g. for version_data we * * currently check the value is a struct gprolog/4 (args are not checked). * * This function can be omitted (in that case no domain_error is checked). * * * * NB: this function is not used by current_prolog_flag (see ISO). * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * INIT_FLAG_SUPP * * * * no declared as other initializers, since we must be sure it has been * * initialized before others (in particular before flag_c.c initializer). * *-------------------------------------------------------------------------*/ static void Init_Flag_Supp(void) { static Bool initialized = FALSE; if (initialized) return; initialized = TRUE; atom_toward_zero = Pl_Create_Atom("toward_zero"); atom_down = Pl_Create_Atom("down"); atom_on = Pl_Create_Atom("on"); atom_off = Pl_Create_Atom("off"); atom_warning = Pl_Create_Atom("warning"); atom_fail = Pl_Create_Atom("fail"); atom_chars = Pl_Create_Atom("chars"); atom_codes = Pl_Create_Atom("codes"); atom_atom = Pl_Create_Atom("atom"); atom_chars_no_escape = Pl_Create_Atom("chars_no_escape"); atom_codes_no_escape = Pl_Create_Atom("codes_no_escape"); atom_atom_no_escape = Pl_Create_Atom("atom_no_escape"); } /*-------------------------------------------------------------------------* * FCT_GET_xxx FCT_CHK_xxx FCT_SET_xxx * * * *-------------------------------------------------------------------------*/ static WamWord Fct_Get_Integer(FlagInf *flag) { return Tag_INT(flag->value); } static Bool Fct_Chk_Integer(FlagInf *flag, WamWord tag_mask, WamWord value_word) { return tag_mask == TAG_INT_MASK; } static Bool Fct_Set_Integer(FlagInf *flag, WamWord value_word) { flag->value = UnTag_INT(value_word); return TRUE; } static WamWord Fct_Get_Atom(FlagInf *flag) { return Tag_ATM(flag->value); } static Bool Fct_Chk_Atom(FlagInf *flag, WamWord tag_mask, WamWord value_word) { return tag_mask == TAG_ATM_MASK; } static Bool Fct_Set_Atom(FlagInf *flag, WamWord value_word) { flag->value = UnTag_ATM(value_word); return TRUE; } static WamWord Fct_Get_Round(FlagInf *flag) { return flag->value == PF_ROUND_ZERO ? Tag_ATM(atom_toward_zero) : Tag_ATM(atom_down); } static Bool Fct_Chk_Round(FlagInf *flag, WamWord tag_mask, WamWord value_word) { int atom = UnTag_ATM(value_word); return tag_mask == TAG_ATM_MASK && (atom == atom_toward_zero || atom == atom_down); } static Bool Fct_Set_Round(FlagInf *flag, WamWord value_word) { int atom = UnTag_ATM(value_word); flag->value = (atom == atom_toward_zero) ? PF_ROUND_ZERO : PF_ROUND_DOWN; return TRUE; } static WamWord Fct_Get_Bool(FlagInf *flag) { return flag->value ? Tag_ATM(pl_atom_true) : Tag_ATM(pl_atom_false); } static Bool Fct_Chk_Bool(FlagInf *flag, WamWord tag_mask, WamWord value_word) { int atom = UnTag_ATM(value_word); return tag_mask == TAG_ATM_MASK && (atom == pl_atom_true || atom == pl_atom_false); } static Bool Fct_Set_Bool(FlagInf *flag, WamWord value_word) { int atom = UnTag_ATM(value_word); flag->value = (atom == pl_atom_true); return TRUE; } static WamWord Fct_Get_On_Off(FlagInf *flag) { return flag->value ? Tag_ATM(atom_on) : Tag_ATM(atom_off); } static Bool Fct_Chk_On_Off(FlagInf *flag, WamWord tag_mask, WamWord value_word) { int atom = UnTag_ATM(value_word); return tag_mask == TAG_ATM_MASK && (atom == atom_on || atom == atom_off); } static Bool Fct_Set_On_Off(FlagInf *flag, WamWord value_word) { int atom = UnTag_ATM(value_word); flag->value = (atom == atom_on); return TRUE; } static WamWord Fct_Get_Err(FlagInf *flag) { int atom; switch (flag->value) { case PF_ERR_ERROR: atom = pl_atom_error; break; case PF_ERR_WARNING: atom = atom_warning; break; case PF_ERR_FAIL: atom = atom_fail; break; } return Tag_ATM(atom); } static Bool Fct_Chk_Err(FlagInf *flag, WamWord tag_mask, WamWord value_word) { int atom = UnTag_ATM(value_word); return tag_mask == TAG_ATM_MASK && (atom == pl_atom_error || atom == atom_warning || atom == atom_fail); } static Bool Fct_Set_Err(FlagInf *flag, WamWord value_word) { int atom = UnTag_ATM(value_word); if (atom == pl_atom_error) flag->value = PF_ERR_ERROR; else if (atom == atom_warning) flag->value = PF_ERR_WARNING; else flag->value = PF_ERR_FAIL; return TRUE; } static WamWord Fct_Get_Quotes(FlagInf *flag) { int atom; switch (flag->value) { case PF_QUOT_AS_CODES: atom = atom_codes; break; case PF_QUOT_AS_CODES | PF_QUOT_NO_ESCAPE_MASK: atom = atom_codes_no_escape; break; case PF_QUOT_AS_CHARS: atom = atom_chars; break; case PF_QUOT_AS_CHARS | PF_QUOT_NO_ESCAPE_MASK: atom = atom_chars_no_escape; break; case PF_QUOT_AS_ATOM: atom = atom_atom; break; case PF_QUOT_AS_ATOM | PF_QUOT_NO_ESCAPE_MASK: atom = atom_atom_no_escape; break; } return Tag_ATM(atom); } static Bool Fct_Chk_Quotes(FlagInf *flag, WamWord tag_mask, WamWord value_word) { int atom = UnTag_ATM(value_word); return tag_mask == TAG_ATM_MASK && (atom == atom_codes || atom == atom_codes_no_escape || atom == atom_chars || atom == atom_chars_no_escape || atom == atom_atom || atom == atom_atom_no_escape); } static Bool Fct_Set_Quotes(FlagInf *flag, WamWord value_word) { int atom = UnTag_ATM(value_word); if (atom == atom_codes) flag->value = PF_QUOT_AS_CODES; else if (atom == atom_codes_no_escape) flag->value = PF_QUOT_AS_CODES | PF_QUOT_NO_ESCAPE_MASK; else if (atom == atom_chars) flag->value = PF_QUOT_AS_CHARS; else if (atom == atom_chars_no_escape) flag->value = PF_QUOT_AS_CHARS | PF_QUOT_NO_ESCAPE_MASK; else if (atom == atom_atom) flag->value = PF_QUOT_AS_ATOM; else flag->value = PF_QUOT_AS_ATOM | PF_QUOT_NO_ESCAPE_MASK; return TRUE; } /*-------------------------------------------------------------------------* * PL_NEW_PROLOG_FLAG * * * *-------------------------------------------------------------------------*/ FlagInf * Pl_New_Prolog_Flag(char *name, Bool modifiable, FlagType type, PlLong value, FlagFctGet fct_get, FlagFctChk fct_chk, FlagFctSet fct_set) { int atom_name; FlagInf *flag; Init_Flag_Supp(); atom_name = Pl_Create_Atom(name); if (nb_flag == NB_OF_FLAGS) Pl_Fatal_Error("Flag table full - increase NB_OF_FLAGS = %d", NB_OF_FLAGS); flag = flag_tbl + nb_flag++; flag->atom_name = atom_name; flag->modifiable = modifiable; flag->type = type; flag->value = value; flag->fct_get = fct_get; flag->fct_chk = fct_chk; flag->fct_set = fct_set; if (fct_get == NULL) { switch(type) { case PF_TYPE_INTEGER: flag->fct_get = Fct_Get_Integer; break; case PF_TYPE_ATOM: flag->fct_get = Fct_Get_Atom; break; case PF_TYPE_BOOL: flag->fct_get = Fct_Get_Bool; break; case PF_TYPE_ON_OFF: flag->fct_get = Fct_Get_On_Off; break; case PF_TYPE_ERR: flag->fct_get = Fct_Get_Err; break; case PF_TYPE_QUOTES: flag->fct_get = Fct_Get_Quotes; break; case PF_TYPE_ROUND: flag->fct_get = Fct_Get_Round; break; case PF_TYPE_ANY: break; /* should not occur */ } } if (fct_chk == NULL) { switch(type) { case PF_TYPE_INTEGER: flag->fct_chk = Fct_Chk_Integer; break; case PF_TYPE_ATOM: flag->fct_chk = Fct_Chk_Atom; break; case PF_TYPE_BOOL: flag->fct_chk = Fct_Chk_Bool; break; case PF_TYPE_ON_OFF: flag->fct_chk = Fct_Chk_On_Off; break; case PF_TYPE_ERR: flag->fct_chk = Fct_Chk_Err; break; case PF_TYPE_QUOTES: flag->fct_chk = Fct_Chk_Quotes; break; case PF_TYPE_ROUND: flag->fct_chk = Fct_Chk_Round; break; case PF_TYPE_ANY: break; /* should not occur (but acceptable) */ } } if (modifiable && fct_set == NULL) { switch(type) { case PF_TYPE_INTEGER: flag->fct_set = Fct_Set_Integer; break; case PF_TYPE_ATOM: flag->fct_set = Fct_Set_Atom; break; case PF_TYPE_BOOL: flag->fct_set = Fct_Set_Bool; break; case PF_TYPE_ON_OFF: flag->fct_set = Fct_Set_On_Off; break; case PF_TYPE_ERR: flag->fct_set = Fct_Set_Err; break; case PF_TYPE_QUOTES: flag->fct_set = Fct_Set_Quotes; break; case PF_TYPE_ROUND: flag->fct_set = Fct_Set_Round; break; case PF_TYPE_ANY: break; /* should not occur */ } } return flag; } /*-------------------------------------------------------------------------* * PL_PROLOG_FLAG_LOOKUP * * * *-------------------------------------------------------------------------*/ static FlagInf * Prolog_Flag_Lookup(int atom_name) { int i; for(i = 0; i < nb_flag; i++) { if (flag_tbl[i].atom_name == atom_name) return flag_tbl + i; } return NULL; } /*-------------------------------------------------------------------------* * PL_SET_PROLOG_FLAG_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Set_Prolog_Flag_2(WamWord flag_word, WamWord value_word) { WamWord word, tag_mask; int atom_name; FlagInf *flag; atom_name = Pl_Rd_Atom_Check(flag_word); flag = Prolog_Flag_Lookup(atom_name); if (flag == NULL) Pl_Err_Domain(pl_domain_prolog_flag, flag_word); DEREF(value_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); value_word = word; /* dereferenced */ if (flag->fct_chk != NULL && !(*flag->fct_chk)(flag, tag_mask, value_word)) { word = Pl_Put_Structure(ATOM_CHAR('+'), 2); Pl_Unify_Value(flag_word); Pl_Unify_Value(value_word); Pl_Err_Domain(pl_domain_flag_value, word); } if (!flag->modifiable) { Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_flag, flag_word); } return (*flag->fct_set)(flag, value_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_PROLOG_FLAG_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Prolog_Flag_2(WamWord flag_word, WamWord value_word) { WamWord word, tag_mask; int atom_name; FlagInf *flag; int i; DEREF(flag_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { atom_name = Pl_Rd_Atom_Check(word); flag = Prolog_Flag_Lookup(atom_name); if (flag == NULL) Pl_Err_Domain(pl_domain_prolog_flag, flag_word); return Pl_Unify((*flag->fct_get)(flag), value_word); } /* non deterministic case */ i = 0; A(0) = flag_word; A(1) = value_word; A(2) = i + 1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PROLOG_FLAG_ALT, 0), 3); flag = flag_tbl + i; Pl_Get_Atom(flag->atom_name, flag_word); return Pl_Unify((*flag->fct_get)(flag), value_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_PROLOG_FLAG_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Prolog_Flag_Alt_0(void) { WamWord flag_word, value_word; FlagInf *flag; int i; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PROLOG_FLAG_ALT, 0), 0); flag_word = AB(B, 0); value_word = AB(B, 1); i = AB(B, 2); flag = flag_tbl + i; if (i + 1 == nb_flag) Delete_Last_Choice_Point(); else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = flag_word; AB(B, 1) = value_word; #endif AB(B, 2) = i + 1; } Pl_Get_Atom(flag->atom_name, flag_word); return Pl_Unify((*flag->fct_get)(flag), value_word); } ���������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/parse_supp.c���������������������������������������������������������������0000644�0001750�0001750�00000063226�13021324543�015635� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : parse_supp.c * * Descr.: parser support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <string.h> #include <ctype.h> #include <setjmp.h> #define OBJ_INIT Parse_Supp_Initializer #define PARSE_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define COMMA_ANY FALSE #define GENERAL_TERM 0 #define TRYING_PREFIX 1 #define INSIDE_ANY_OP 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static StmInf *pstm_i; static Bool tok_present; static TokInf unget_tok; static sigjmp_buf jumper; #if !defined(NO_USE_REGS) && NB_OF_USED_MACHINE_REGS > 0 static WamWord buff_save_machine_regs[NB_OF_USED_MACHINE_REGS]; #endif static int atom_var; static int atom_string; static int atom_punct; static int atom_atom; static int atom_back_quotes; static int atom_full_stop; static int atom_extend; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Read_Next_Token(Bool comma_is_punct); static WamWord Parse_Term(int cur_prec, int context, Bool comma_is_punct); static WamWord Parse_Args_Of_Functor(int atom); static WamWord Parse_Bracketed_Term(void); static WamWord Parse_List(Bool can_be_empty); static WamWord Create_Structure(int func, int arity, WamWord *arg); static int Lookup_In_Dico_Var(char *name); static void Parse_Error(char *err_msg); /* we simply save line/col (for error report) to avoid to * duplicate the entire token (with the big buffer for names). * After Unget_Token it is possible to restore pl_token.line/col */ #define Unget_Token \ do { \ tok_present = TRUE; \ unget_tok = pl_token; \ } while(0) #define Update_Last_Read_Position \ { \ pl_last_read_line = pl_token.line; \ pl_last_read_col = pl_token.col; \ } /*-------------------------------------------------------------------------* * PARSE_SUPP_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Parse_Supp_Initializer(void) { atom_var = Pl_Create_Atom("var"); atom_string = Pl_Create_Atom("string"); atom_punct = Pl_Create_Atom("punct"); atom_atom = Pl_Create_Atom("atom"); atom_back_quotes = Pl_Create_Atom("back_quotes"); atom_full_stop = Pl_Create_Atom("full_stop"); atom_extend = Pl_Create_Atom("extend"); } /*-------------------------------------------------------------------------* * READ_NEXT_TOKEN * * * *-------------------------------------------------------------------------*/ static void Read_Next_Token(Bool comma_is_punct) { char *err_msg; if (tok_present) { tok_present = FALSE; pl_token = unget_tok; if (comma_is_punct && pl_token.type == TOKEN_NAME && !pl_token.quoted && pl_token.name[0] == ',' && pl_token.name[1] == '\0') { pl_token.type = TOKEN_PUNCTUATION; pl_token.punct = ','; } else if (!comma_is_punct && pl_token.type == TOKEN_PUNCTUATION && pl_token.punct == ',') { pl_token.type = TOKEN_NAME; pl_token.quoted = FALSE; pl_token.name[0] = ','; pl_token.name[1] = '\0'; } } else if ((err_msg = Pl_Scan_Token(pstm_i, comma_is_punct)) != NULL) Parse_Error(err_msg); } /*-------------------------------------------------------------------------* * PL_READ_TERM * * * * Returns a Prolog term as a WAM word or NOT_A_WAM_WORD on syntax error. * * parse_end_of_term controls the end of term (see parse_supp.h). * * Uses the value of: FLAG_DOUBLE_QUOTES, FLAG_BACK_QUOTES * *-------------------------------------------------------------------------*/ WamWord Pl_Read_Term(StmInf *pstm, int parse_end_of_term) { int jmp_val; WamWord term; int save_use_le_prompt = pl_use_le_prompt; pl_use_le_prompt = 1; pl_parse_nb_var = 0; pl_last_read_line = -1; pstm_i = pstm; tok_present = FALSE; Save_Machine_Regs(buff_save_machine_regs); jmp_val = sigsetjmp(jumper, 1); Restore_Machine_Regs(buff_save_machine_regs); if (jmp_val == 0) { term = Parse_Term(MAX_PREC, GENERAL_TERM, COMMA_ANY); Read_Next_Token(COMMA_ANY); if (term == NOT_A_WAM_WORD) { if (pl_token.type == TOKEN_END_OF_FILE) { term = Pl_Put_Atom(pl_atom_end_of_file); goto finish; } else { /* Unget_Token; */ /* useless if followed by Parse_Error */ Parse_Error("expression expected"); } } if (parse_end_of_term == PARSE_END_OF_TERM_DOT) { if (pl_token.type == TOKEN_FULL_STOP) goto finish; else { /* Unget_Token; */ /* useless if followed by Parse_Error */ Parse_Error(". or operator expected after expression"); } } /* parse_end_of_term == PARSE_END_OF_TERM_EOF */ if (pl_token.type == TOKEN_END_OF_FILE) goto finish; else { /* Unget_Token; */ /* useless if followed by Parse_Error */ Parse_Error("eof or operator expected after expression"); } } else /* Syntax Error (Restore) */ { Restore_Machine_Regs(buff_save_machine_regs); term = NOT_A_WAM_WORD; } finish: pl_use_le_prompt = save_use_le_prompt; return term; } /*-------------------------------------------------------------------------* * PARSE_TERM * * * * Recursively parses a term whose precedence is <=cur_prec and returns a * * WamWord associated to the term. If a syntax error is encountered the * * parser returns NOT_A_WAM_WORD and update syntax error information * * (see Set_Last_Syntax_Error_Info() in error_supp.c). * * The flag comma_is_punct specifies if an eventual ',' following the term * * must be considered as a punctuation (separator of args of compound term * * or of a list) or as an atom. The value COMMA_ANY is used when this flag * * is not relevant (only for comprehensivity). * * Since the Pl_Scan_Token() only consumes necessary characters, the * * function Pl_Stream_Peekc() returns the character immediately after the * * pl_token. * * This feature is used to detect negative numbers and open bracket * * (thus the next call to Pl_Scan_Token() will return TOKEN_IMMEDIAT_OPEN).* * We use Pl_Scan_Peek_Char() instead of Pl_Stream_Peekc() only to deal * * with character conversion. * *-------------------------------------------------------------------------*/ static WamWord Parse_Term(int cur_prec, int context, Bool comma_is_punct) { Bool bracket; int atom; OperInf *oper; Bool infix_op; int cur_left = 0; int i; int flag_value; WamWord term, term1; WamWord w[2]; Bool left_is_op = FALSE; Read_Next_Token(context != TRYING_PREFIX || comma_is_punct); if (pl_last_read_line == -1) Update_Last_Read_Position; switch (pl_token.type) { case TOKEN_VARIABLE: i = Lookup_In_Dico_Var(pl_token.name); if (++pl_parse_dico_var[i].nb_of_uses == 1) /* first occurence */ { term = Pl_Put_X_Variable(); pl_parse_dico_var[i].word = term; } else /* other occurence */ term = pl_parse_dico_var[i].word; break; case TOKEN_INTEGER: if (pl_token.int_num > INT_GREATEST_VALUE) Parse_Error("integer overflow (exceeds max_integer)"); if (pl_token.int_num < INT_LOWEST_VALUE) Parse_Error("integer underflow (exceeds min_integer)"); term = Pl_Put_Integer(pl_token.int_num); break; case TOKEN_FLOAT: term = Pl_Put_Float(pl_token.float_num); break; case TOKEN_STRING: case TOKEN_BACK_QUOTED: /* undefined in ISO */ flag_value = (pl_token.type == TOKEN_STRING) ? Flag_Value(double_quotes) : Flag_Value(back_quotes); flag_value &= PF_QUOT_AS_PART_MASK; if (flag_value == PF_QUOT_AS_ATOM) { atom = Pl_Create_Allocate_Atom(pl_token.name); goto a_name; } i = strlen(pl_token.name); term = NIL_WORD; /* faster than Pl_Put_Nil() */ while (i--) { term1 = Pl_Put_List(); if (flag_value == PF_QUOT_AS_CODES) Pl_Unify_Integer(pl_token.name[i]); else Pl_Unify_Atom(ATOM_CHAR(pl_token.name[i])); Pl_Unify_Value(term); term = term1; } break; case TOKEN_IMMEDIAT_OPEN: pl_token.punct = '('; /* and then like TOKEN_PUNCTUATION */ case TOKEN_PUNCTUATION: if (!strchr("({[", pl_token.punct)) { term = NOT_A_WAM_WORD; goto finish; } atom = (pl_token.punct == '{') ? pl_atom_curly_brackets : ATOM_NIL; term = Parse_Bracketed_Term(); if (term == NOT_A_WAM_WORD) /* name: {} or [] */ goto a_name; break; case TOKEN_NAME: atom = Pl_Create_Allocate_Atom(pl_token.name); a_name: bracket = (Pl_Scan_Peek_Char(pstm_i, TRUE) == '('); if (bracket) { term = Parse_Args_Of_Functor(atom); break; } /* test if it is a negative number */ if (pl_token.name[0] == '-' && pl_token.name[1] == '\0' #ifndef MINUS_SIGN_CAN_BE_FOLLOWED_BY_SPACES && isdigit(Pl_Scan_Peek_Char(pstm_i, TRUE)) #endif ) { int save_line = pl_token.line; int save_col = pl_token.col; Read_Next_Token(COMMA_ANY); if (pl_token.type == TOKEN_INTEGER) { if (pl_token.int_num > -INT_LOWEST_VALUE) Parse_Error("integer underflow (exceeds min_integer)"); term = Pl_Put_Integer(-pl_token.int_num); break; } if (pl_token.type == TOKEN_FLOAT) { term = Pl_Put_Float(-pl_token.float_num); break; } /* '-' not followed by a number, pushback this token */ /* (cannot occur ifndef MINUS_SIGN_CAN_BE_FOLLOWED_BY_SPACES) */ Unget_Token; /* restore token */ pl_token.type = TOKEN_NAME; strcpy(pl_token.name, "-"); pl_token.line = save_line; pl_token.col = save_col; } /* maybe a prefix operator */ if ((oper = Pl_Lookup_Oper(atom, PREFIX)) && cur_prec >= oper->prec) { /* try a prefix operator */ cur_left = oper->prec; term = Parse_Term(oper->right, TRYING_PREFIX, comma_is_punct); if (term != NOT_A_WAM_WORD) { term = Create_Structure(atom, 1, &term); break; } /* prefix operator as a name */ if (context != GENERAL_TERM) Parse_Error("expression expected or previous operator needs brackets"); } left_is_op = (Check_Oper_Any_Type(atom)); if (left_is_op && context != GENERAL_TERM) /* in operator context */ { if (Check_Oper(atom, INFIX) || Check_Oper(atom, POSTFIX)) Parse_Error("current or previous operator needs brackets"); else Parse_Error("current operator needs brackets"); } term = Pl_Put_Atom(atom); break; default: /* TOKEN_END_OF_FILE, TOKEN_FULL_STOP, TOKEN_EXTENDED */ term = NOT_A_WAM_WORD; goto finish; } for (;;) { Read_Next_Token(comma_is_punct); #if 1 /* to allow | to be unquoted if it is an infix operator with prec > 1000 */ if (pl_token.type == TOKEN_PUNCTUATION && pl_token.punct == '|' && (oper = Pl_Lookup_Oper(atom = ATOM_CHAR('|'), INFIX)) && oper->prec > 1000 && cur_prec >= oper->prec) infix_op = TRUE; else #endif { if (pl_token.type != TOKEN_NAME) break; atom = Pl_Create_Allocate_Atom(pl_token.name); if ((oper = Pl_Lookup_Oper(atom, INFIX))) infix_op = TRUE; else if ((oper = Pl_Lookup_Oper(atom, POSTFIX))) infix_op = FALSE; else break; } if (left_is_op) Parse_Error("previous operator needs brackets"); if (cur_prec < oper->prec || cur_left > oper->left) break; if (infix_op) /* infix operator */ { w[0] = term; w[1] = Parse_Term(oper->right, INSIDE_ANY_OP, comma_is_punct); if (w[1] == NOT_A_WAM_WORD) Parse_Error("right operand expected for infix operator"); if (atom == ATOM_CHAR('.')) { term = Pl_Put_List(); Pl_Unify_Value(w[0]); Pl_Unify_Value(w[1]); } else term = Create_Structure(atom, 2, w); } else term = Create_Structure(atom, 1, &term); /* postfix operator */ cur_left = oper->prec; } finish: Unget_Token; return term; } /*-------------------------------------------------------------------------* * PARSE_ARGS_OF_FUNCTOR * * * *-------------------------------------------------------------------------*/ static WamWord Parse_Args_Of_Functor(int atom) { WamWord w[NB_OF_X_REGS]; int i; Read_Next_Token(COMMA_ANY); /* the immediate ( */ i = 0; do { if (i >= MAX_ARITY) Parse_Error("too big compound term (exceeds max_arity)"); w[i] = Parse_Term(MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, TRUE); if (w[i++] == NOT_A_WAM_WORD) Parse_Error("expression expected"); Read_Next_Token(TRUE); } while (pl_token.type == TOKEN_PUNCTUATION && pl_token.punct == ','); if (pl_token.type != TOKEN_PUNCTUATION || pl_token.punct != ')') Parse_Error(", or ) expected"); return Create_Structure(atom, i, w); } /*-------------------------------------------------------------------------* * PARSE_BRACKETED_TERM * * * *-------------------------------------------------------------------------*/ static WamWord Parse_Bracketed_Term(void) { WamWord term; switch (pl_token.punct) { case '(': term = Parse_Term(MAX_PREC, GENERAL_TERM, COMMA_ANY); if (term == NOT_A_WAM_WORD) Parse_Error("expression expected"); Read_Next_Token(COMMA_ANY); if (pl_token.type != TOKEN_PUNCTUATION || pl_token.punct != ')') Parse_Error(") or operator expected"); break; case '{': term = Parse_Term(MAX_PREC, GENERAL_TERM, COMMA_ANY); Read_Next_Token(COMMA_ANY); if (pl_token.type != TOKEN_PUNCTUATION || pl_token.punct != '}') Parse_Error("} or operator expected"); if (term != NOT_A_WAM_WORD) /* term == NOT_A_WAM_WORD if {} */ term = Create_Structure(pl_atom_curly_brackets, 1, &term); break; case '[': term = Parse_List(TRUE); /* term == NOT_A_WAM_WORD if [] */ break; } return term; } /*-------------------------------------------------------------------------* * PARSE_LIST * * * *-------------------------------------------------------------------------*/ static WamWord Parse_List(Bool can_be_empty) { WamWord term; WamWord car_word, cdr_word; car_word = Parse_Term(MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, TRUE); Read_Next_Token(TRUE); if (car_word == NOT_A_WAM_WORD) { if (!can_be_empty) Parse_Error("expression expected in list"); else if (pl_token.type != TOKEN_PUNCTUATION || pl_token.punct != ']') Parse_Error("expression or ] expected in list"); return NOT_A_WAM_WORD; } if (pl_token.type != TOKEN_PUNCTUATION || !strchr(",|]", pl_token.punct)) Parse_Error(", | ] or operator expected in list"); switch (pl_token.punct) { case ',': /* [X,Y...] */ cdr_word = Parse_List(FALSE); break; case '|': /* [X|Y] */ cdr_word = Parse_Term(MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, COMMA_ANY); if (cdr_word == NOT_A_WAM_WORD) Parse_Error("expression expected in list"); Read_Next_Token(TRUE); if (pl_token.type != TOKEN_PUNCTUATION || pl_token.punct != ']') Parse_Error("] or operator expected in list"); break; case ']': /* [X] */ cdr_word = NIL_WORD; /* faster than Pl_Put_Nil() */ break; } term = Pl_Put_List(); Pl_Unify_Value(car_word); Pl_Unify_Value(cdr_word); return term; } /*-------------------------------------------------------------------------* * CREATE_STRUCTURE * * * * like Mk_Compound but simplified since we know arity != 0 and arg != NULL* *-------------------------------------------------------------------------*/ static WamWord Create_Structure(int func, int arity, WamWord *arg) { WamWord res_word; int i; if (arity == 2 && func == ATOM_CHAR('.')) { res_word = Pl_Put_List(); Pl_Unify_Value(arg[0]); Pl_Unify_Value(arg[1]); } else { res_word = Pl_Put_Structure(func, arity); for (i = 0; i < arity; i++) Pl_Unify_Value(arg[i]); } return res_word; } /*-------------------------------------------------------------------------* * LOOKUP_IN_DICO_VAR * * * *-------------------------------------------------------------------------*/ static int Lookup_In_Dico_Var(char *name) { int i; Bool named; if (name[0] != '_' || name[1] != '\0') { named = TRUE; for (i = 0; i < pl_parse_nb_var && strcmp(name, pl_parse_dico_var[i].name) != 0; i++) ; } else { named = FALSE; i = pl_parse_nb_var; } if (i == pl_parse_nb_var) { if (pl_parse_nb_var >= MAX_VAR_IN_TERM) Parse_Error("too many variables in a term"); strcpy(pl_parse_dico_var[pl_parse_nb_var].name, name); pl_parse_dico_var[pl_parse_nb_var].word = NOT_A_WAM_WORD; pl_parse_dico_var[pl_parse_nb_var].named = named; pl_parse_dico_var[pl_parse_nb_var].nb_of_uses = 0; pl_parse_nb_var++; } return i; } /*-------------------------------------------------------------------------* * PARSE_ERROR * * * *-------------------------------------------------------------------------*/ static void Parse_Error(char *err_msg) { Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm_i->atom_file_name].name, pl_token.line, pl_token.col, err_msg); if (pl_token.type != TOKEN_FULL_STOP) Pl_Recover_After_Error(pstm_i); Save_Machine_Regs(buff_save_machine_regs); siglongjmp(jumper, 1); } /* Other facilities */ /*-------------------------------------------------------------------------* * PL_READ_ATOM * * * * Returns a Prolog atom as a WAM word or NOT_A_WAM_WORD on syntax error. * *-------------------------------------------------------------------------*/ WamWord Pl_Read_Atom(StmInf *pstm) { char *err_msg; if ((err_msg = Pl_Scan_Next_Atom(pstm)) != NULL) { Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm->atom_file_name].name, pl_token.line, pl_token.col, err_msg); return NOT_A_WAM_WORD; } Update_Last_Read_Position; return Pl_Put_Atom(Pl_Create_Allocate_Atom(pl_token.name)); } /*-------------------------------------------------------------------------* * PL_READ_INTEGER * * * * Returns a Prolog integer as a WAM word or NOT_A_WAM_WORD on syntax error* *-------------------------------------------------------------------------*/ WamWord Pl_Read_Integer(StmInf *pstm) { char *err_msg; if ((err_msg = Pl_Scan_Next_Number(pstm, TRUE)) != NULL) { Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm->atom_file_name].name, pl_token.line, pl_token.col, err_msg); return NOT_A_WAM_WORD; } Update_Last_Read_Position; return Pl_Put_Integer(pl_token.int_num); } /*-------------------------------------------------------------------------* * PL_READ_NUMBER * * * * Returns a Prolog number as a WAM word or NOT_A_WAM_WORD on syntax error.* *-------------------------------------------------------------------------*/ WamWord Pl_Read_Number(StmInf *pstm) { char *err_msg; if ((err_msg = Pl_Scan_Next_Number(pstm, FALSE)) != NULL) { Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm->atom_file_name].name, pl_token.line, pl_token.col, err_msg); return NOT_A_WAM_WORD; } Update_Last_Read_Position; return (pl_token.type == TOKEN_INTEGER) ? Pl_Put_Integer(pl_token.int_num) : Pl_Put_Float(pl_token.float_num); } /*-------------------------------------------------------------------------* * PL_READ_TOKEN * * * * Returns a Prolog token as a WAM word or NOT_A_WAM_WORD on syntax error. * *-------------------------------------------------------------------------*/ WamWord Pl_Read_Token(StmInf *pstm) { WamWord term, arg; int func, atom; char *err_msg; if ((err_msg = Pl_Scan_Token(pstm, FALSE)) != NULL) { Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm->atom_file_name].name, pl_token.line, pl_token.col, err_msg); return NOT_A_WAM_WORD; } Update_Last_Read_Position; term = NOT_A_WAM_WORD; switch (pl_token.type) { case TOKEN_VARIABLE: func = atom_var; arg_of_struct: atom = Pl_Create_Allocate_Atom(pl_token.name); arg = Pl_Put_Atom(atom); break; case TOKEN_INTEGER: term = Pl_Put_Integer(pl_token.int_num); break; case TOKEN_FLOAT: term = Pl_Put_Float(pl_token.float_num); break; case TOKEN_STRING: func = atom_string; goto arg_of_struct; case TOKEN_IMMEDIAT_OPEN: pl_token.punct = '('; /* and then like TOKEN_PUNCTUATION */ case TOKEN_PUNCTUATION: func = atom_punct; atom = ATOM_CHAR(pl_token.punct); arg = Pl_Put_Atom(atom); break; case TOKEN_NAME: atom = Pl_Create_Allocate_Atom(pl_token.name); term = Pl_Put_Atom(atom); break; case TOKEN_BACK_QUOTED: /* undefined in ISO */ func = atom_back_quotes; goto arg_of_struct; case TOKEN_FULL_STOP: func = atom_punct; arg = Pl_Put_Atom(atom_full_stop); break; case TOKEN_END_OF_FILE: func = atom_punct; arg = Pl_Put_Atom(pl_atom_end_of_file); break; case TOKEN_EXTENDED: func = atom_extend; goto arg_of_struct; } if (term == NOT_A_WAM_WORD) { term = Pl_Put_Structure(func, 1); Pl_Unify_Value(arg); } return term; } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stream_supp.c��������������������������������������������������������������0000644�0001750�0001750�00000147201�13021324543�016012� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : stream_supp.c * * Descr.: stream support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <stdarg.h> #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> #ifdef clearerr /* prevent the case clearerr is (also) a macro */ #undef clearerr extern void clearerr(FILE *stream); #endif #if defined(FOR_EXTERNAL_USE) && defined(W32_GUI_CONSOLE) #undef W32_GUI_CONSOLE #endif #define STREAM_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" #ifndef NO_USE_LINEDIT #include "linedit.h" #endif #ifdef _WIN32 #include <io.h> #else #include <unistd.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ #define START_ALIAS_TBL_SIZE 128 #define STR_STREAM_WRITE_BLOCK 1024 #define TTY_BUFFER_SIZE 1024 #define BIG_BUFFER 65535 /* Error Messages */ #define ERR_TELL_OR_SEEK_UNDEFINED "fct tell or seek undefined\n" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static void Init_Stream_Supp(); void (*pl_init_stream_supp)() = Init_Stream_Supp; /* overwrite var of engine.c */ static int atom_constant_term_stream; static WamWord stream_1; static WamWord word_current_input_stream; static WamWord word_current_output_stream; static StrSInf static_str_stream_rd = { NULL, NULL, 0 }; /* input */ static StrSInf static_str_stream_wr = { NULL, NULL, 0 }; /* output */ #ifndef NO_USE_LINEDIT static char tty_first_buff[TTY_BUFFER_SIZE]; /* current buffer (end with '\0') */ static char *tty_buff; static char *tty_ptr = NULL; /* current pointer into the buff */ #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int Find_Free_Stream(void); static void Del_Aliases_Of_Stream(int stm); static void Update_Mirrors_To_Del_Stream(int stm); static Bool Remove_In_Stream_List(int stm, StmLst **p_start); #ifndef NO_USE_LINEDIT static int TTY_Getc(void); static int TTY_Get_Key(Bool echo, Bool catch_ctrl_c); static void TTY_Clearerr(void); #endif static int Basic_Call_Fct_Getc(StmInf *pstm); static void Basic_Call_Fct_Putc(int c, StmInf *pstm); static int Str_Stream_Getc(StrSInf *str_stream); static void Str_Stream_Putc(int c, StrSInf *str_stream); /*-------------------------------------------------------------------------* * INIT_STREAM_SUPP * * * * no declared as other initializers, since we must be sure it has been * * initialized before others. * *-------------------------------------------------------------------------*/ static void Init_Stream_Supp(void) { #ifndef NO_USE_LINEDIT StmInf *pstm; #endif pl_stm_tbl_size = 32; pl_stm_tbl = (StmInf **) Calloc(pl_stm_tbl_size, sizeof(StmInf *)); pl_stm_last_used = -1; pl_alias_tbl = Pl_Hash_Alloc_Table(START_ALIAS_TBL_SIZE, sizeof(AliasInf)); pl_atom_stream = Pl_Create_Atom("$stream"); stream_1 = Functor_Arity(pl_atom_stream, 1); atom_constant_term_stream = Pl_Create_Atom("constant term stream"); word_current_input_stream = Tag_ATM(Pl_Create_Atom("current_input_stream")); word_current_output_stream = Tag_ATM(Pl_Create_Atom("current_output_stream")); pl_atom_user_input = Pl_Create_Atom("user_input"); pl_atom_user_output = Pl_Create_Atom("user_output"); pl_atom_user_error = Pl_Create_Atom("user_error"); pl_atom_top_level_input = Pl_Create_Atom("top_level_input"); pl_atom_top_level_output = Pl_Create_Atom("top_level_output"); pl_atom_debugger_input = Pl_Create_Atom("debugger_input"); pl_atom_debugger_output = Pl_Create_Atom("debugger_output"); pl_atom_read = Pl_Create_Atom("read"); pl_atom_write = Pl_Create_Atom("write"); pl_atom_append = Pl_Create_Atom("append"); pl_atom_reposition = Pl_Create_Atom("reposition"); pl_atom_stream_position = Pl_Create_Atom("$stream_position"); pl_atom_text = Pl_Create_Atom("text"); pl_atom_binary = Pl_Create_Atom("binary"); pl_atom_error = Pl_Create_Atom("error"); pl_atom_eof_code = Pl_Create_Atom("eof_code"); pl_atom_reset = Pl_Create_Atom("reset"); pl_atom_none = Pl_Create_Atom("none"); pl_atom_line = Pl_Create_Atom("line"); pl_atom_block = Pl_Create_Atom("block"); pl_atom_not = Pl_Create_Atom("not"); pl_atom_at = Pl_Create_Atom("at"); pl_atom_past = Pl_Create_Atom("past"); pl_atom_bof = Pl_Create_Atom("bof"); pl_atom_current = Pl_Create_Atom("current"); pl_atom_eof = Pl_Create_Atom("eof"); pl_le_prompt = ""; pl_use_le_prompt = TRUE; pl_stm_stdin = Pl_Add_Stream_For_Stdio_Desc(stdin, pl_atom_user_input, STREAM_MODE_READ, TRUE); #ifndef NO_USE_LINEDIT if (pl_le_mode == LE_MODE_HOOK || (pl_le_mode == LE_MODE_TTY && isatty(0))) { pstm = pl_stm_tbl[pl_stm_stdin]; pstm->fct_getc = (StmFct) TTY_Getc; pstm->fct_putc = STREAM_FCT_UNDEFINED; pstm->fct_flush = STREAM_FCT_UNDEFINED; pstm->fct_close = STREAM_FCT_UNDEFINED; pstm->fct_tell = STREAM_FCT_UNDEFINED; pstm->fct_seek = STREAM_FCT_UNDEFINED; pstm->fct_clearerr = (StmFct) TTY_Clearerr; pl_stream_use_linedit = TRUE; } #endif Pl_Add_Alias_To_Stream(pl_atom_user_input, pl_stm_stdin); pl_stm_input = pl_stm_stdin; pl_stm_stdout = Pl_Add_Stream_For_Stdio_Desc(stdout, pl_atom_user_output, STREAM_MODE_WRITE, TRUE); #if !defined(NO_USE_LINEDIT) && defined(_WIN32) /* ok for both GUI and console EOM<->ANSI conversion */ pstm = pl_stm_tbl[pl_stm_stdout]; pstm->prop.buffering = STREAM_BUFFERING_LINE; if (pl_le_hook_put_char && isatty(1)) pstm->fct_putc = (StmFct) pl_le_hook_put_char; if (pl_le_hook_flush && isatty(1)) pstm->fct_flush = (StmFct) pl_le_hook_flush; #endif Pl_Add_Alias_To_Stream(pl_atom_user_output, pl_stm_stdout); pl_stm_output = pl_stm_stdout; pl_stm_stderr = Pl_Add_Stream_For_Stdio_Desc(stderr, pl_atom_user_error, STREAM_MODE_WRITE, TRUE); #if !defined(NO_USE_LINEDIT) && defined(_WIN32) /* ok for both GUI and console EOM<->ANSI conversion */ pstm = pl_stm_tbl[pl_stm_stderr]; pstm->prop.buffering = STREAM_BUFFERING_LINE; if (pl_le_hook_put_char && isatty(2)) pstm->fct_putc = (StmFct) pl_le_hook_put_char; if (pl_le_hook_flush && isatty(2)) pstm->fct_flush = (StmFct) pl_le_hook_flush; #endif Pl_Add_Alias_To_Stream(pl_atom_user_error, pl_stm_stderr); pl_stm_error = pl_stm_stderr; pl_stm_top_level_input = pl_stm_debugger_input = pl_stm_input; pl_stm_top_level_output = pl_stm_debugger_output = pl_stm_output; Pl_Add_Alias_To_Stream(pl_atom_top_level_input, pl_stm_top_level_input); Pl_Add_Alias_To_Stream(pl_atom_top_level_output, pl_stm_top_level_output); Pl_Add_Alias_To_Stream(pl_atom_debugger_input, pl_stm_debugger_input); Pl_Add_Alias_To_Stream(pl_atom_debugger_output, pl_stm_debugger_output); } #ifndef FOR_EXTERNAL_USE /*-------------------------------------------------------------------------* * PL_PROP_AND_STDIO_MODE * * * *-------------------------------------------------------------------------*/ StmProp Pl_Prop_And_Stdio_Mode(int mode, Bool text, char *open_str) { StmProp prop; prop.mode = mode; switch(mode) { case STREAM_MODE_READ: prop.input = TRUE; prop.output = FALSE; *open_str++ = 'r'; break; case STREAM_MODE_WRITE: prop.input = FALSE; prop.output = TRUE; *open_str++ = 'w'; break; case STREAM_MODE_APPEND: prop.input = FALSE; prop.output = TRUE; *open_str++ = 'a'; } prop.text = text; prop.reposition = TRUE; prop.eof_action = STREAM_EOF_ACTION_EOF_CODE; prop.buffering = STREAM_BUFFERING_BLOCK; prop.special_close = FALSE; prop.other = 0; *open_str++ = (text) ? 't' : 'b'; *open_str = '\0'; return prop; } /*-------------------------------------------------------------------------* * PL_ADD_STREAM_FOR_STDIO_DESC * * * *-------------------------------------------------------------------------*/ int Pl_Add_Stream_For_Stdio_Desc(FILE *f, int atom_path, int mode, int text) { char open_str[10]; StmProp prop = Pl_Prop_And_Stdio_Mode(mode, text, open_str); prop.reposition = Pl_Stdio_Is_Repositionable(f); prop.buffering = (prop.reposition) ? STREAM_BUFFERING_BLOCK : STREAM_BUFFERING_LINE; Pl_Stdio_Set_Buffering(f, prop.buffering); if (isatty(fileno(f))) prop.eof_action = STREAM_EOF_ACTION_RESET; return Pl_Add_Stream(atom_path, (PlLong) f, prop, NULL, NULL, NULL, NULL, NULL, NULL, NULL); } /*-------------------------------------------------------------------------* * PL_ADD_STREAM_FOR_STDIO_FILE * * * *-------------------------------------------------------------------------*/ int Pl_Add_Stream_For_Stdio_File(char *path, int mode, Bool text) { FILE *f; char open_str[10]; int atom_path; Pl_Prop_And_Stdio_Mode(mode, text, open_str); /* only for open_str */ if ((f = fopen(path, open_str)) == NULL) return -1; atom_path = Pl_Create_Allocate_Atom(path); return Pl_Add_Stream_For_Stdio_Desc(f, atom_path, mode, text); } #endif /* !FOR_EXTERNAL_USE */ /*-------------------------------------------------------------------------* * INIT_STREAM_STRUCT * * * *-------------------------------------------------------------------------*/ static void Init_Stream_Struct(int atom_file_name, PlLong file, StmProp prop, StmFct fct_getc, StmFct fct_putc, StmFct fct_flush, StmFct fct_close, StmFct fct_tell, StmFct fct_seek, StmFct fct_clearerr, StmInf *pstm) { pstm->atom_file_name = atom_file_name; pstm->file = file; pstm->prop = prop; pstm->mirror = NULL; pstm->mirror_of = NULL; #define INIT_FCT(f, d) pstm->f = (f) ? f : (StmFct) d INIT_FCT(fct_getc, fgetc); INIT_FCT(fct_putc, fputc); INIT_FCT(fct_flush, fflush); INIT_FCT(fct_close, fclose); INIT_FCT(fct_tell, ftell); INIT_FCT(fct_seek, fseek); INIT_FCT(fct_clearerr, clearerr); /* Works only because putc will be called with c as 1st arg and flush's arg is ignored */ pstm->eof_reached = FALSE; PB_Init(pstm->pb_char); pstm->char_count = 0; pstm->line_count = 0; pstm->line_pos = 0; PB_Init(pstm->pb_line_pos); } /*-------------------------------------------------------------------------* * PL_ADD_STREAM * * * *-------------------------------------------------------------------------*/ int Pl_Add_Stream(int atom_file_name, PlLong file, StmProp prop, StmFct fct_getc, StmFct fct_putc, StmFct fct_flush, StmFct fct_close, StmFct fct_tell, StmFct fct_seek, StmFct fct_clearerr) { int stm; StmInf *pstm; stm = Find_Free_Stream(); if (prop.reposition && (fct_tell == STREAM_FCT_UNDEFINED || fct_seek == STREAM_FCT_UNDEFINED)) Pl_Fatal_Error(ERR_TELL_OR_SEEK_UNDEFINED); pstm = pl_stm_tbl[stm]; Init_Stream_Struct(atom_file_name, file, prop, fct_getc, fct_putc, fct_flush, fct_close, fct_tell, fct_seek, fct_clearerr, pstm); return stm; } /*-------------------------------------------------------------------------* * REMOVE_STREAM * * * *-------------------------------------------------------------------------*/ void Pl_Delete_Stream(int stm) { Del_Aliases_Of_Stream(stm); Update_Mirrors_To_Del_Stream(stm); Free(pl_stm_tbl[stm]); pl_stm_tbl[stm] = NULL; while(pl_stm_tbl[pl_stm_last_used] == NULL) pl_stm_last_used--; } /*-------------------------------------------------------------------------* * FIND_FREE_STREAM * * * *-------------------------------------------------------------------------*/ static int Find_Free_Stream(void) { int stm; for (stm = 0; stm < pl_stm_tbl_size; stm++) if (pl_stm_tbl[stm] == NULL) break; if (stm == pl_stm_tbl_size) Pl_Extend_Array((char **) &pl_stm_tbl, &pl_stm_tbl_size, sizeof(StmInf *), TRUE); pl_stm_tbl[stm] = (StmInf *) Malloc(sizeof(StmInf)); if (stm > pl_stm_last_used) pl_stm_last_used = stm; return stm; } /*-------------------------------------------------------------------------* * PL_FIND_STREAM_BY_ALIAS * * * *-------------------------------------------------------------------------*/ int Pl_Find_Stream_By_Alias(int atom_alias) { AliasInf *alias; alias = (AliasInf *) Pl_Hash_Find(pl_alias_tbl, atom_alias); return (alias == NULL) ? -1 : alias->stm; } /*-------------------------------------------------------------------------* * PL_ADD_ALIAS_TO_STREAM * * * *-------------------------------------------------------------------------*/ Bool Pl_Add_Alias_To_Stream(int atom_alias, int stm) { AliasInf *alias; AliasInf alias_info; alias = (AliasInf *) Pl_Hash_Find(pl_alias_tbl, atom_alias); if (alias != NULL) return alias->stm == stm; /* fail if assigned to another stream */ Pl_Extend_Table_If_Needed(&pl_alias_tbl); alias_info.atom = atom_alias; alias_info.stm = stm; alias = (AliasInf *) Pl_Hash_Insert(pl_alias_tbl, (char *) &alias_info, FALSE); return TRUE; } /*-------------------------------------------------------------------------* * PL_REASSIGN_ALIAS * * * *-------------------------------------------------------------------------*/ void Pl_Reassign_Alias(int atom_alias, int stm) { AliasInf *alias; alias = (AliasInf *) Pl_Hash_Find(pl_alias_tbl, atom_alias); if (alias != NULL) alias->stm = stm; } /*-------------------------------------------------------------------------* * DEL_ALIASES_OF_STREAM * * * *-------------------------------------------------------------------------*/ void Del_Aliases_Of_Stream(int stm) { HashScan scan; AliasInf *alias; for (alias = (AliasInf *) Pl_Hash_First(pl_alias_tbl, &scan); alias; alias = (AliasInf *) Pl_Hash_Next(&scan)) if (alias->stm == stm) Pl_Hash_Delete(pl_alias_tbl, alias->atom); } /*-------------------------------------------------------------------------* * PL_ADD_MIRROR_TO_STREAM * * * *-------------------------------------------------------------------------*/ void Pl_Add_Mirror_To_Stream(int stm, int m_stm) { StmInf *pstm = pl_stm_tbl[stm]; StmInf *m_pstm = pl_stm_tbl[m_stm]; StmLst *m; if (stm == m_stm) return; for(m = pstm->mirror; m ; m = m->next) if (m->stm == m_stm) /* already present */ return; m = (StmLst *) Malloc(sizeof(StmLst)); m->stm = m_stm; m->next = pstm->mirror; pstm->mirror = m; m = (StmLst *) Malloc(sizeof(StmLst)); m->stm = stm; m->next = m_pstm->mirror_of; m_pstm->mirror_of = m; } /*-------------------------------------------------------------------------* * PL_DEL_MIRROR_FROM_STREAM * * * *-------------------------------------------------------------------------*/ Bool Pl_Del_Mirror_From_Stream(int stm, int m_stm) { StmInf *pstm = pl_stm_tbl[stm]; StmInf *m_pstm = pl_stm_tbl[m_stm]; if (!Remove_In_Stream_List(m_stm, &pstm->mirror)) return FALSE; /* not found */ Remove_In_Stream_List(stm, &m_pstm->mirror_of); return TRUE; } /*-------------------------------------------------------------------------* * UPDATE_MIRRORS_TO_DEL_STREAM * * * *-------------------------------------------------------------------------*/ static void Update_Mirrors_To_Del_Stream(int stm) { StmInf *pstm = pl_stm_tbl[stm]; StmInf *m_pstm; StmLst *m, *m1; m = pstm->mirror; while(m) { m1 = m; m_pstm = pl_stm_tbl[m->stm]; m = m->next; Free(m1); Remove_In_Stream_List(stm, &m_pstm->mirror_of); } m = pstm->mirror_of; while(m) { m1 = m; m_pstm = pl_stm_tbl[m->stm]; m = m->next; Free(m1); Remove_In_Stream_List(stm, &m_pstm->mirror); } } /*-------------------------------------------------------------------------* * REMOVE_IN_STREAM_LIST * * * *-------------------------------------------------------------------------*/ static Bool Remove_In_Stream_List(int stm, StmLst **p_start) { StmLst *m; for(;;) { m = *p_start; if (m == NULL) break; if (m->stm == stm) /* found */ { *p_start = m->next; Free(m); return TRUE; } p_start = &m->next; } return FALSE; /* not found */ } /*-------------------------------------------------------------------------* * PL_FIND_STREAM_FROM_PSTM * * * *-------------------------------------------------------------------------*/ int Pl_Find_Stream_From_PStm(StmInf *pstm) { int stm; for (stm = 0; stm <= pl_stm_last_used; stm++) if (pl_stm_tbl[stm] == pstm) return stm; return -1; } /*-------------------------------------------------------------------------* * PL_FLUSH_ALL_STREAMS * * * *-------------------------------------------------------------------------*/ void Pl_Flush_All_Streams(void) { int stm; for (stm = 0; stm <= pl_stm_last_used ; stm++) if (pl_stm_tbl[stm]) Pl_Stream_Flush(pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_SET_STREAM_BUFFERING * * * *-------------------------------------------------------------------------*/ void Pl_Set_Stream_Buffering(int stm) { StmInf *pstm = pl_stm_tbl[stm]; FILE *f; f = Pl_Stdio_Desc_Of_Stream(stm); if (f == NULL) { pstm->prop.buffering = STREAM_BUFFERING_NONE; return; } #ifndef NO_USE_LINEDIT /* if GUI: inform it about buffering */ if ((pstm->file == (PlLong) stdout || pstm->file == (PlLong) stderr) && pl_le_hook_set_line_buffering) (*pl_le_hook_set_line_buffering)(pstm->prop.buffering != STREAM_BUFFERING_NONE); else #endif Pl_Stdio_Set_Buffering(f, pstm->prop.buffering); } #ifndef FOR_EXTERNAL_USE /*-------------------------------------------------------------------------* * PL_GET_STREAM_OR_ALIAS * * * * return the associated stm or -1 if not exist (test==STREAM_CHECK_VALID) * *-------------------------------------------------------------------------*/ int Pl_Get_Stream_Or_Alias(WamWord sora_word, int test) { WamWord word, tag_mask, tag_mask1; int atom; WamWord *stc_adr; PlLong stm = 0; /* only for the compiler (NB: defined as PlLong to check validity) */ int perm_oper; DEREF(sora_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) /* alias ? */ { atom = UnTag_ATM(word); stm = Pl_Find_Stream_By_Alias(atom); goto next_test; } if (tag_mask == TAG_STC_MASK) /* stream ? */ { stc_adr = UnTag_STC(word); DEREF(Arg(stc_adr, 0), word, tag_mask1); stm = UnTag_INT(word); if (Functor_And_Arity(stc_adr) == stream_1 && tag_mask1 == TAG_INT_MASK) goto next_test; } if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); Pl_Err_Domain(pl_domain_stream_or_alias, sora_word); next_test: if ((PlULong) stm > (PlULong) pl_stm_last_used || pl_stm_tbl[stm] == NULL) { if (test == STREAM_CHECK_VALID) return -1; Pl_Err_Existence(pl_existence_stream, sora_word); } if (test == STREAM_CHECK_VALID || test == STREAM_CHECK_EXIST) goto ok; if (test == STREAM_CHECK_INPUT) { if (pl_stm_tbl[stm]->prop.input) goto ok; perm_oper = pl_permission_operation_input; } else /* test == STREAM_CHECK_OUTPUT */ { if (pl_stm_tbl[stm]->prop.output) goto ok; perm_oper = pl_permission_operation_output; } Pl_Err_Permission(perm_oper, pl_permission_type_stream, sora_word); ok: return (int) stm; } /*-------------------------------------------------------------------------* * PL_CHECK_STREAM_TYPE * * * *-------------------------------------------------------------------------*/ void Pl_Check_Stream_Type(int stm, Bool check_text, Bool for_input) { int perm_oper; int perm_type; WamWord sora_word; if (check_text) { if (pl_stm_tbl[stm]->prop.text) return; perm_type = pl_permission_type_binary_stream; } else /* check binary */ { if (!pl_stm_tbl[stm]->prop.text) return; perm_type = pl_permission_type_text_stream; } /* here there is an error */ if (for_input) { perm_oper = pl_permission_operation_input; sora_word = (pl_last_input_sora == NOT_A_WAM_WORD) ? word_current_input_stream : pl_last_input_sora; } else /* for output */ { perm_oper = pl_permission_operation_output; sora_word = (pl_last_output_sora == NOT_A_WAM_WORD) ? word_current_output_stream : pl_last_output_sora; } Pl_Err_Permission(perm_oper, perm_type, sora_word); } #endif /* !FOR_EXTERNAL_USE */ /*-------------------------------------------------------------------------* * PL_MAKE_STREAM_TAGGED_WORD * * * *-------------------------------------------------------------------------*/ WamWord Pl_Make_Stream_Tagged_Word(int stm) { static WamWord h[2]; h[0] = stream_1; h[1] = Tag_INT(stm); return Tag_STC(h); } /*-------------------------------------------------------------------------* * PL_STDIO_IS_REPOSITIONABLE * * * *-------------------------------------------------------------------------*/ Bool Pl_Stdio_Is_Repositionable(FILE *f) { int fd = fileno(f); return !isatty(fd) && lseek(fd, 0, SEEK_CUR) >= 0; } /*-------------------------------------------------------------------------* * PL_STDIO_SET_BUFFERING * * * *-------------------------------------------------------------------------*/ void Pl_Stdio_Set_Buffering(FILE *f, int buffering) { int buff_flag; switch (buffering) { case STREAM_BUFFERING_NONE: buff_flag = _IONBF; break; case STREAM_BUFFERING_LINE: buff_flag = _IOLBF; #ifdef _WIN32 #ifndef NO_USE_LINEDIT if (!pl_le_mode != LE_MODE_HOOK) /* in Win32 console app, line buff = full */ #endif buff_flag = _IONBF; /* I prefer no buffering */ #endif break; case STREAM_BUFFERING_BLOCK: buff_flag = _IOFBF; break; } setvbuf(f, NULL, buff_flag, BUFSIZ); } /*-------------------------------------------------------------------------* * PL_STDIO_DESC_OF_STREAM * * * * return a FILE * of a stream or NULL if it is not a stdio stream. * *-------------------------------------------------------------------------*/ FILE * Pl_Stdio_Desc_Of_Stream(int stm) { StmInf *pstm = pl_stm_tbl[stm]; if (stm == pl_stm_stdin) /* works also for stdin with linedit */ return stdin; if (pstm->fct_getc == (StmFct) fgetc) return (FILE *) (pstm->file); return NULL; } /*-------------------------------------------------------------------------* * PL_IO_FILENO_OF_STREAM * * * * return the fileno of a stream or -1 if this stream has not a fileno. * *-------------------------------------------------------------------------*/ int Pl_Io_Fileno_Of_Stream(int stm) { FILE *f; f = Pl_Stdio_Desc_Of_Stream(stm); if (f) return fileno(f); return -1; } /*-------------------------------------------------------------------------* * The following functions replace standard fgetc/... on stdin if a TTY. * * It uses linedit to provide a more comfortable interface. * * These functions should not be used directly but via the common interface* * provided by the Stream_Getc/... functions (see below). * *-------------------------------------------------------------------------*/ #ifndef NO_USE_LINEDIT #define SAVE_FOR_REENTRANCY \ { \ int save_sys_var_option_mask = SYS_VAR_OPTION_MASK; \ int save_last_read_line = pl_last_read_line; \ int save_last_read_col = pl_last_read_col; #define RESTORE_FOR_REENTRANCY \ SYS_VAR_OPTION_MASK = save_sys_var_option_mask; \ pl_last_read_line = save_last_read_line; \ pl_last_read_col = save_last_read_col; \ } /*-------------------------------------------------------------------------* * TTY_GETC * * * * we must take care to reentrancy: e.g. top_level calls TTY_Getc which * * calls LE_FGets + Ctrl_C + b(reak) + new top_level + TTY_Getc... * *-------------------------------------------------------------------------*/ static int TTY_Getc(void) { int c; StmInf *pstm; static int tty_linedit_depth = 0; if (tty_ptr == NULL) { if (tty_linedit_depth++ == 0) tty_buff = tty_first_buff; else tty_buff = (char *) Malloc(TTY_BUFFER_SIZE); /* tty_ptr must remain NULL for reentrancy */ SAVE_FOR_REENTRANCY; tty_buff = Pl_LE_FGets(tty_buff, TTY_BUFFER_SIZE, pl_le_prompt, pl_use_le_prompt); pl_use_le_prompt = 0; RESTORE_FOR_REENTRANCY; tty_linedit_depth--; if (LE_Interrupted_By_Ctrl_C(tty_buff)) Pl_Execute_A_Continuation((CodePtr) Pl_LE_Get_Ctrl_C_Return_Value()); if (tty_buff == NULL) { c = EOF; goto test_free_buff; } tty_ptr = tty_buff; /* simulate the echo (+ '\n') on output */ pstm = pl_stm_tbl[pl_stm_stdout]; pstm->char_count += strlen(tty_buff); pstm->line_count++; pstm->line_pos = 0; } c = *tty_ptr++; if (*tty_ptr == '\0') { test_free_buff: if (tty_buff != tty_first_buff) Free(tty_buff); tty_ptr = NULL; } return c; } /*-------------------------------------------------------------------------* * TTY_GET_KEY * * * *-------------------------------------------------------------------------*/ static int TTY_Get_Key(Bool echo, Bool catch_ctrl_c) { int c; if (tty_ptr != NULL) { c = *tty_ptr++; if (*tty_ptr == '\0') { if (tty_buff != tty_first_buff) Free(tty_buff); tty_ptr = NULL; } return c; } SAVE_FOR_REENTRANCY; c = Pl_LE_Get_Key(echo, catch_ctrl_c); RESTORE_FOR_REENTRANCY; if (LE_Interrupted_By_Ctrl_C(c)) Pl_Execute_A_Continuation((CodePtr) Pl_LE_Get_Ctrl_C_Return_Value()); return c; } /*-------------------------------------------------------------------------* * TTY_CLEARERR * * * *-------------------------------------------------------------------------*/ static void TTY_Clearerr(void) { clearerr(stdin); } #endif /* NO_USE_LINEDIT */ /*-------------------------------------------------------------------------* * Only the following functions should be used to read/write a stream. * *-------------------------------------------------------------------------*/ #ifdef FOR_EXTERNAL_USE #define Before_Reading(pstm, file) #else #define Before_Reading(pstm, file) \ { \ if (pstm->eof_reached) \ { \ if (pstm->prop.eof_action == STREAM_EOF_ACTION_ERROR) \ Pl_Err_Permission(pl_permission_operation_input, \ pl_permission_type_past_end_of_stream, \ (pl_last_input_sora == NOT_A_WAM_WORD) \ ? word_current_input_stream \ : pl_last_input_sora); \ \ if (pstm->prop.eof_action == STREAM_EOF_ACTION_EOF_CODE) \ return EOF; \ \ /* here: eof_action == STREAM_EOF_ACTION_RESET */ \ pstm->eof_reached = FALSE; \ if (pstm->prop.reposition) \ Pl_Stream_Set_Position(pstm, SEEK_SET, 0, 0, 0, 0); \ if (pstm->fct_clearerr != STREAM_FCT_UNDEFINED) \ (*pstm->fct_clearerr) (file); \ } \ } #endif /* FOR_EXTERNAL_USE */ #define Update_Counters(pstm, c) \ if (c != EOF) \ pstm->char_count++; \ if (c == '\n') \ { \ pstm->line_count++; \ pstm->line_pos = 0; \ } \ else \ pstm->line_pos++ /*-------------------------------------------------------------------------* * BASIC_CALL_FCT_GETC * * * *-------------------------------------------------------------------------*/ static int Basic_Call_Fct_Getc(StmInf *pstm) { int c; StmLst *m; #ifndef NO_USE_PIPED_STDIN_FOR_CONSULT if (SYS_VAR_SAY_GETC && pstm->file == (PlLong) stdin) /* could also test pstm->fct_getc == fgetc */ { putchar(CHAR_TO_EMIT_WHEN_CHAR); fflush(stdout); } #endif c = (*pstm->fct_getc) (pstm->file); if (c != EOF) for (m = pstm->mirror; m ; m = m->next) Pl_Stream_Putc(c, pl_stm_tbl[m->stm]); return c; } /*-------------------------------------------------------------------------* * BASIC_CALL_FCT_PUTC * * * *-------------------------------------------------------------------------*/ static void Basic_Call_Fct_Putc(int c, StmInf *pstm) { StmLst *m; (*pstm->fct_putc) (c, pstm->file); for (m = pstm->mirror; m ; m = m->next) Pl_Stream_Putc(c, pl_stm_tbl[m->stm]); } /*-------------------------------------------------------------------------* * PL_PB_EMPTY_BUFFER * * * *-------------------------------------------------------------------------*/ void Pl_PB_Empty_Buffer(StmInf *pstm) { PB_Init(pstm->pb_char) } /*-------------------------------------------------------------------------* * PL_STREAM_GET_KEY * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Get_Key(StmInf *pstm, int echo, int catch_ctrl_c) { int c; PlLong file = pstm->file; Bool simulate; #ifndef NO_USE_LINEDIT if (pl_le_mode != LE_MODE_DEACTIVATED && pstm == pl_stm_tbl[pl_stm_stdin]) /* the stdin stream used with linedit */ simulate = FALSE; else #endif simulate = TRUE; Before_Reading(pstm, file); if (!PB_Is_Empty(pstm->pb_char)) { PB_Pop(pstm->pb_char, c); } else { Start_Protect_Regs_For_Signal; if (simulate) c = Basic_Call_Fct_Getc(pstm); #ifndef NO_USE_LINEDIT else c = TTY_Get_Key(echo, catch_ctrl_c); #endif Stop_Protect_Regs_For_Signal; } if (simulate && c != '\n') { while (Basic_Call_Fct_Getc(pstm) >= ' ') ; Update_Counters(pl_stm_tbl[pl_stm_stdout], '\n'); /* reflect \n */ } if (c == EOF) pstm->eof_reached = TRUE; if (c == '\n') PB_Push(pstm->pb_line_pos, pstm->line_pos); Update_Counters(pstm, c); return c; } /*-------------------------------------------------------------------------* * PL_STREAM_GETC * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Getc(StmInf *pstm) { int c; PlLong file = pstm->file; Before_Reading(pstm, file); if (!PB_Is_Empty(pstm->pb_char)) { PB_Pop(pstm->pb_char, c); } else { Start_Protect_Regs_For_Signal; c = Basic_Call_Fct_Getc(pstm); Stop_Protect_Regs_For_Signal; } if (c == EOF) pstm->eof_reached = TRUE; if (c == '\n') PB_Push(pstm->pb_line_pos, pstm->line_pos); Update_Counters(pstm, c); return c; } /*-------------------------------------------------------------------------* * PL_STREAM_UNGETC * * * * Several issues should not occur except if more '\n' are unget than read * * (when a Pl_Stream_Set_Position() is used the number of read '\n' is 0). * *-------------------------------------------------------------------------*/ void Pl_Stream_Ungetc(int c, StmInf *pstm) { PB_Push(pstm->pb_char, c); pstm->eof_reached = FALSE; if (pstm->char_count > 0) /* test should be useless */ pstm->char_count--; if (c == '\n') { if (pstm->line_count > 0) /* test should be useless */ pstm->line_count--; if (!PB_Is_Empty(pstm->pb_line_pos)) PB_Pop(pstm->pb_line_pos, pstm->line_pos); else pstm->line_pos = 0; /* should not occur */ } else if (pstm->line_pos > 0) /* test should be useless */ pstm->line_pos--; } /*-------------------------------------------------------------------------* * PL_STREAM_PEEKC * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Peekc(StmInf *pstm) { int c; PlLong file = pstm->file; Before_Reading(pstm, file); if (!PB_Is_Empty(pstm->pb_char)) PB_Top(pstm->pb_char, c); else { c = Basic_Call_Fct_Getc(pstm); PB_Push(pstm->pb_char, c); } return c; } /*-------------------------------------------------------------------------* * PL_STREAM_GETS * * * *-------------------------------------------------------------------------*/ char * Pl_Stream_Gets(char *str, int size, StmInf *pstm) { int c; char *p = str; for (;;) { if (p - str >= size) break; c = Pl_Stream_Getc(pstm); if (c == EOF) break; *p++ = c; if (c == '\n') break; } if (c == EOF && p == str) return NULL; *p = '\0'; return str; } /*-------------------------------------------------------------------------* * PL_STREAM_GETS_PROMPT * * * *-------------------------------------------------------------------------*/ char * Pl_Stream_Gets_Prompt(char *prompt, StmInf *pstm_o, char *str, int size, StmInf *pstm_i) { #ifndef NO_USE_LINEDIT char *save_le_prompt = pl_le_prompt; int save_use_le_prompt = pl_use_le_prompt; pl_le_prompt = prompt; pl_use_le_prompt = 1; if (pstm_i->fct_getc != TTY_Getc) #endif Pl_Stream_Printf(pstm_o, prompt); str = Pl_Stream_Gets(str, size, pstm_i); #ifndef NO_USE_LINEDIT pl_use_le_prompt = save_use_le_prompt; pl_le_prompt = save_le_prompt; #endif return str; } /*-------------------------------------------------------------------------* * PL_STREAM_PUTC * * * *-------------------------------------------------------------------------*/ void Pl_Stream_Putc(int c, StmInf *pstm) { Basic_Call_Fct_Putc(c, pstm); Update_Counters(pstm, c); } /*-------------------------------------------------------------------------* * PL_STREAM_PUTS * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Puts(char *str, StmInf *pstm) { char *p; int c; for (p = str; *p; p++) { c = *p; Basic_Call_Fct_Putc(c, pstm); /* like Stream_Putc */ Update_Counters(pstm, c); } return p - str; } /*-------------------------------------------------------------------------* * PL_STREAM_PRINTF * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Printf(StmInf *pstm, char *format, ...) { va_list arg_ptr; static char str[BIG_BUFFER]; char *p; int c; va_start(arg_ptr, format); vsprintf(str, format, arg_ptr); va_end(arg_ptr); for (p = str; *p; p++) { c = *p; Basic_Call_Fct_Putc(c, pstm); /* like Stream_Putc */ Update_Counters(pstm, c); } return p - str; } /*-------------------------------------------------------------------------* * PL_STREAM_FLUSH * * * *-------------------------------------------------------------------------*/ void Pl_Stream_Flush(StmInf *pstm) { PlLong file = pstm->file; if (pstm->prop.output && pstm->fct_flush != STREAM_FCT_UNDEFINED) (*pstm->fct_flush) (file); } /*-------------------------------------------------------------------------* * PL_STREAM_CLOSE * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Close(StmInf *pstm) { PlLong file = pstm->file; int ret = 0; if (pstm->fct_close != STREAM_FCT_UNDEFINED) ret = (*pstm->fct_close) (file); return ret; } /*-------------------------------------------------------------------------* * PL_STREAM_END_OF_STREAM * * * *-------------------------------------------------------------------------*/ int Pl_Stream_End_Of_Stream(StmInf *pstm) { int c; if (pstm->prop.eof_action == STREAM_EOF_ACTION_RESET || !pstm->prop.input) return STREAM_EOF_NOT; if (pstm->eof_reached) return STREAM_EOF_PAST; c = Pl_Stream_Peekc(pstm); if (c == EOF) return STREAM_EOF_AT; return STREAM_EOF_NOT; } /*-------------------------------------------------------------------------* * PL_STREAM_GET_POSITION * * * *-------------------------------------------------------------------------*/ void Pl_Stream_Get_Position(StmInf *pstm, PlLong *offset, PlLong *char_count, PlLong *line_count, PlLong *line_pos) { PlLong file = pstm->file; *offset = 0; if (pstm->prop.reposition && pstm->fct_tell != STREAM_FCT_UNDEFINED) { if ((*offset = (*pstm->fct_tell) (file)) < 0) *offset = 0; else { *offset = *offset - pstm->pb_char.nb_elems; if (*offset < 0) *offset = 0; } } *char_count = pstm->char_count; if (pstm->prop.text) { *line_count = pstm->line_count; *line_pos = pstm->line_pos; } else { *line_count = 0; *line_pos = 0; } } /*-------------------------------------------------------------------------* * PL_STREAM_SET_POSITION * * * *-------------------------------------------------------------------------*/ int Pl_Stream_Set_Position(StmInf *pstm, int whence, PlLong offset, PlLong char_count, PlLong line_count, PlLong line_pos) { PlLong file = pstm->file; int x; x = (*pstm->fct_seek) (file, (PlLong) offset, whence); if (x != 0) return x; pstm->char_count = char_count; if (pstm->prop.text) { pstm->line_count = line_count; pstm->line_pos = line_pos; } if (pstm->eof_reached) { pstm->eof_reached = FALSE; if (pstm->fct_clearerr != STREAM_FCT_UNDEFINED) (*pstm->fct_clearerr) (file); } PB_Init(pstm->pb_char); PB_Init(pstm->pb_line_pos); return 0; } /*-------------------------------------------------------------------------* * PL_STREAM_SET_POSITION_LC * * * * Only the line count and the line position are given. * *-------------------------------------------------------------------------*/ int Pl_Stream_Set_Position_LC(StmInf *pstm, PlLong line_count, PlLong line_pos) { PlLong file = pstm->file; int x; PlLong *p; int c; int offset; Bool save_eof_reached; int save_char_count, save_line_count, save_line_pos; int save_char_nb_elems; offset = (*pstm->fct_tell) (file); if (offset < 0) return offset; x = (*pstm->fct_seek) (file, (PlLong) 0, SEEK_SET); if (x != 0) return x; save_eof_reached = pstm->eof_reached; save_char_count = pstm->char_count; save_line_count = pstm->line_count; save_line_pos = pstm->line_pos; save_char_nb_elems = pstm->pb_char.nb_elems; pstm->char_count = 0; pstm->line_count = 0; pstm->line_pos = 0; pstm->pb_char.nb_elems = 0; if (pstm->eof_reached) { pstm->eof_reached = FALSE; if (pstm->fct_clearerr != STREAM_FCT_UNDEFINED) (*pstm->fct_clearerr) (file); } p = &(pstm->line_count); while (*p < line_count) if (Pl_Stream_Getc(pstm) == EOF) goto err; p = &(pstm->line_pos); while (*p < line_pos) { if ((c = Pl_Stream_Getc(pstm)) == EOF) goto err; if (c == '\n') goto err; } PB_Init(pstm->pb_char); PB_Init(pstm->pb_line_pos); return 0; err: pstm->eof_reached = save_eof_reached; pstm->char_count = save_char_count; pstm->line_count = save_line_count; pstm->line_pos = save_line_pos; pstm->pb_char.nb_elems = save_char_nb_elems; x = (*pstm->fct_seek) (file, (PlLong) offset, SEEK_SET); if (x != 0) return x; return -2; } /*-------------------------------------------------------------------------* * The following functions allows the user to handle streams on C strings * * Any stream can be a string stream. To avoid unnecessary malloc/free, we * * use as long as possible 2 str stream statically allocated (1 for input, * * 1 for output). This optimizes the use of preds like write_to_atom/2,... * * NB: The buff of the output static str stream is reused (no free on it). * * A dynamic str stream is allocated when it is not possible to use static * * ones. Such a str stream is freed at the close. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_ADD_STR_STREAM * * * * buff == NULL means output stream mode (str_stream->buff_alloc_size != 0)* *-------------------------------------------------------------------------*/ int Pl_Add_Str_Stream(char *buff, int prop_other) { int stm; StmInf *pstm; StmProp prop; StrSInf *str_stream; str_stream = (buff) ? &static_str_stream_rd : &static_str_stream_wr; if (str_stream->ptr != NULL) /* in use ? */ { str_stream = (StrSInf *) Malloc(sizeof(StrSInf)); str_stream->buff_alloc_size = 0; } if (buff) { str_stream->buff = buff; prop.mode = STREAM_MODE_READ; prop.input = TRUE; prop.output = FALSE; } else { if (str_stream->buff_alloc_size == 0) { str_stream->buff = (char *) Malloc(STR_STREAM_WRITE_BLOCK); str_stream->buff_alloc_size = STR_STREAM_WRITE_BLOCK; } prop.mode = STREAM_MODE_WRITE; prop.input = FALSE; prop.output = TRUE; } str_stream->ptr = str_stream->buff; /* ptr != NULL <=> in use for global */ prop.text = 1; prop.reposition = FALSE; prop.buffering = STREAM_BUFFERING_NONE; prop.eof_action = STREAM_EOF_ACTION_EOF_CODE; prop.special_close = TRUE; prop.other = prop_other; stm = Find_Free_Stream(); pstm = pl_stm_tbl[stm]; Init_Stream_Struct(atom_constant_term_stream, (PlLong) str_stream, prop, (StmFct) Str_Stream_Getc, (StmFct) Str_Stream_Putc, STREAM_FCT_UNDEFINED, STREAM_FCT_UNDEFINED, STREAM_FCT_UNDEFINED, STREAM_FCT_UNDEFINED, STREAM_FCT_UNDEFINED, pstm); return stm; } /*-------------------------------------------------------------------------* * PL_DELETE_STR_STREAM * * * *-------------------------------------------------------------------------*/ void Pl_Delete_Str_Stream(int stm) { StrSInf *str_stream = (StrSInf *) (pl_stm_tbl[stm]->file); if (str_stream == &static_str_stream_rd || str_stream == &static_str_stream_wr) { str_stream->ptr = NULL; /* not in use */ } else { if (str_stream->buff_alloc_size) Free(str_stream->buff); Free(str_stream); } Pl_Delete_Stream(stm); } /*-------------------------------------------------------------------------* * PL_TERM_WRITE_STR_STREAM * * * * only needed for output string stream. * *-------------------------------------------------------------------------*/ char * Pl_Term_Write_Str_Stream(int stm) { StrSInf *str_stream; str_stream = (StrSInf *) (pl_stm_tbl[stm]->file); *(str_stream->ptr) = '\0'; return str_stream->buff; } /*-------------------------------------------------------------------------* * STR_STREAM_GETC * * * *-------------------------------------------------------------------------*/ static int Str_Stream_Getc(StrSInf *str_stream) { int c; c = *(str_stream->ptr); if (c == '\0') return EOF; (str_stream->ptr)++; return c; } /*-------------------------------------------------------------------------* * STR_STREAM_PUTC * * * *-------------------------------------------------------------------------*/ static void Str_Stream_Putc(int c, StrSInf *str_stream) { int size = str_stream->ptr - str_stream->buff; int new_size; if (size >= str_stream->buff_alloc_size - 1) /* -1 for last '\0' */ { new_size = str_stream->buff_alloc_size + STR_STREAM_WRITE_BLOCK; str_stream->buff = Realloc(str_stream->buff, new_size); str_stream->buff_alloc_size = new_size; str_stream->ptr = str_stream->buff + size; } *(str_stream->ptr)++ = c; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/file.pl��������������������������������������������������������������������0000644�0001750�0001750�00000007047�13021324543�014563� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : file.pl * * Descr.: file name management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_file'. absolute_file_name(Path1, Path2) :- set_bip_name(absolute_file_name, 2), '$call_c_test'('Pl_Absolute_File_Name_2'(Path1, Path2)). is_absolute_file_name(Path) :- set_bip_name(is_absolute_file_name, 1), '$call_c_test'('Pl_Is_Absolute_File_Name_1'(Path)). is_relative_file_name(Path) :- set_bip_name(is_relative_file_name, 1), '$call_c_test'('Pl_Is_Relative_File_Name_1'(Path)). decompose_file_name(Path, Dir, Prefix, Suffix) :- set_bip_name(decompose_file_name, 4), '$call_c_test'('Pl_Decompose_File_Name_4'(Path, Dir, Prefix, Suffix)). prolog_file_name(PlFile, PlFile1) :- set_bip_name(prolog_file_name, 2), '$call_c_test'('Pl_Prolog_File_Name_2'(PlFile, PlFile1)). '$prolog_file_suffix'(Suffix) :- set_bip_name(prolog_file_suffix, 1), '$call_c_test'('Pl_Prolog_File_Suffix_1'(Suffix)). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pretty.wam�����������������������������������������������������������������0000644�0001750�0001750�00000017637�13021356407�015356� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : pretty.pl file_name('/home/diaz/GP/src/BipsPl/pretty.pl'). predicate(system:'$use_pretty'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:portray_clause/1,44,static,private,monofile,built_in,[ try_me_else(1), allocate(2), get_variable(y(0),0), put_value(y(0),0), put_integer(1,1), put_variable(y(1),2), call('$portray_clause'/3), put_value(y(0),0), put_unsafe_value(y(1),1), call_c('Pl_Portray_Clause_2',[],[x(0),x(1)]), fail, label(1), trust_me_else_fail, proceed]). predicate(system:portray_clause/2,54,static,private,monofile,built_in,[ try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),1), put_value(y(1),0), put_integer(2,1), put_variable(y(2),2), call('$portray_clause'/3), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(2),2), call_c('Pl_Portray_Clause_3',[],[x(0),x(1),x(2)]), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$portray_clause'/3,64,static,private,monofile,built_in,[ try_me_else(1), allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_value(x(2),0), call('$get_current_B'/1), put_atom(portray_clause,0), put_value(y(1),1), call_c('Pl_Set_Bip_Name_2',[],[x(0),x(1)]), put_value(y(0),0), call('$$portray_clause/3_$aux1'/1), put_value(y(0),0), call('$$portray_clause/3_$aux2'/1), put_value(y(0),0), call(name_singleton_vars/1), put_value(y(0),0), put_structure(exclude/1,2), unify_list, unify_local_value(y(0)), unify_nil, put_list(1), unify_value(x(2)), unify_nil, call(bind_variables/2), put_atom(portray_clause,0), put_value(y(1),1), deallocate, call_c('Pl_Set_Bip_Name_2',[],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, fail]). predicate(system:'$$portray_clause/3_$aux2'/1,64,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, put_value(x(0),1), put_atom(callable,0), execute('$pl_err_type'/2)]). predicate(system:'$$portray_clause/3_$aux1'/1,64,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, proceed]). predicate(system:name_singleton_vars/1,84,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[name_singleton_vars,1]), call_c('Pl_Name_Singleton_Vars_1',[],[x(0)]), proceed]). predicate(system:name_query_vars/2,91,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[name_query_vars,2]), call_c('Pl_Name_Query_Vars_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:bind_variables/2,100,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[bind_variables,2]), call('$set_bind_variables_defaults'/0), put_value(y(1),0), put_variable(y(2),1), put_variable(y(3),2), put_variable(y(4),3), call('$get_bind_variables_options'/4), put_value(y(0),0), put_unsafe_value(y(2),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), deallocate, execute('$bind_variables'/4)]). predicate(system:'$bind_variables'/4,107,static,private,monofile,built_in,[ call_c('Pl_Bind_Variables_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$set_bind_variables_defaults'/0,113,static,private,monofile,built_in,[ put_integer(0,0), put_integer(0,1), execute('$sys_var_write'/2)]). predicate(system:'$get_bind_variables_options'/4,119,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), call('$check_list'/1), put_atom('$bind_exclude',0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$bind_from',0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$bind_next',0), put_void(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), call('$get_bind_variables_options1'/1), put_atom('$bind_exclude',0), put_value(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom('$bind_from',0), put_value(y(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom('$bind_next',0), put_value(y(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed]). predicate(system:'$get_bind_variables_options1'/1,130,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call('$get_bind_variables_options2'/1), cut(y(1)), put_value(y(0),0), deallocate, execute('$get_bind_variables_options1'/1)]). predicate(system:'$get_bind_variables_options2'/1,137,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(14), switch_on_term(4,2,fail,fail,3), label(2), switch_on_atom([(numbervars,11),(namevars,13)]), label(3), switch_on_structure([(exclude/1,5),(from/1,7),(next/1,9)]), label(4), try_me_else(6), label(5), get_structure(exclude/1,0), unify_variable(x(1)), put_atom('$bind_exclude',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), proceed, label(6), retry_me_else(8), label(7), allocate(1), get_structure(from/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_atom('$bind_from',0), put_value(y(0),1), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), deallocate, proceed, label(8), retry_me_else(10), label(9), allocate(1), get_structure(next/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_atom('$bind_next',0), put_value(y(0),1), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), deallocate, proceed, label(10), retry_me_else(12), label(11), get_atom(numbervars,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_write'/2), label(12), trust_me_else_fail, label(13), get_atom(namevars,0), put_integer(0,0), put_integer(1,1), execute('$sys_var_write'/2), label(14), trust_me_else_fail, put_value(x(0),1), put_atom(var_binding_option,0), execute('$pl_err_domain'/2)]). predicate(system:numbervars/1,164,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[numbervars,1]), call('$set_bind_variables_defaults'/0), put_value(y(0),0), put_nil(1), put_integer(0,2), put_void(3), deallocate, execute('$bind_variables'/4)]). predicate(system:numbervars/3,170,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[numbervars,3]), call('$set_bind_variables_defaults'/0), put_value(y(0),0), put_nil(1), put_value(y(1),2), put_value(y(2),3), deallocate, execute('$bind_variables'/4)]). �������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/expand_c.c�����������������������������������������������������������������0000644�0001750�0001750�00000036516�13021324543�015237� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : expand_c.c * * Descr.: expand term management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <sys/types.h> #define OBJ_INIT Expand_Initializer #include "engine_pl.h" #include "bips_pl.h" #ifndef _WIN32 #include <unistd.h> #include <sys/wait.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord *top; static Bool opt_term_unif; /* opt_term_unif: can we optimize equality between an in/out var and terminals ? */ static int atom_clause; static int atom_phrase; static int atom_if; static int atom_soft_if; static int atom_neg; static WamWord dcg_2; /* OPT_EQUAL_BETWEEN_IN_OUT_VARS * * optimize equality between in/out vars by doing an unification. * This occurs for ! or { Goal }. * * E.g.: a --> !,b. can give rise to: * a(A,B) :- !, A=A1, b(A1,B). (not optimized) * a(A,B) :- !, b(A,B). (optimized) * * Possible values for the macro: 0 = never, 1 = always, 2 = steadfast * * Steadfastness: since phrase/3 is steadfast, if phrase/3 is always invoked the above * optimization can always be done. However, if the predicate (here a/2) is directly called * the last argument should be a variable. The problem occurs if ! or { Goal } is the last element: * * E.g.: a --> ! can give rise to * a(A,B) :- !, A=B. (not optimized but steadfast) * a(A,A) :- !. (optimized but not steadfast) * * E.g.: a --> { throw(foo) } can give rise to: * a(A,B) :- throw(foo), A=B. (not optimized but steadfast) * a(A,A) :- throw(foo). (optimized but not steadfast) */ #define OPT_EQUAL_BETWEEN_IN_OUT_VARS 2 /*---------------------------------* * Function Prototypes * *---------------------------------*/ static WamWord Dcg_Head(WamWord dcg_head_word, WamWord *in_word, WamWord *out_word, WamWord **end_lst_adr); static WamWord Dcg_Body(WamWord dcg_body_word, Bool for_alt, WamWord in_word, WamWord out_word, WamWord *end_lst_adr); static void Dcg_Body_On_Stack(WamWord dcg_body_word, Bool opt_equal_between_in_out_vars, WamWord in_word, WamWord out_word); static void Dcg_Term_List_On_Stack(WamWord *lst_adr, WamWord in_word, WamWord out_word); static WamWord Dcg_Compound1(int func, WamWord w1); static WamWord Dcg_Compound2(int func, WamWord w1, WamWord w2); /*-------------------------------------------------------------------------* * EXPAND_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Expand_Initializer(void) { int atom_dcg; atom_dcg = Pl_Create_Atom("-->"); atom_clause = Pl_Create_Atom(":-"); atom_phrase = Pl_Create_Atom("phrase"); atom_if = Pl_Create_Atom("->"); atom_soft_if = Pl_Create_Atom("*->"); /* soft-cut */ atom_neg = Pl_Create_Atom("\\+"); dcg_2 = Functor_Arity(atom_dcg, 2); } /*-------------------------------------------------------------------------* * PL_DCG_TRANS_RULE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Dcg_Trans_Rule_2(WamWord rule_word, WamWord clause_word) { WamWord word, tag_mask; WamWord *adr; WamWord in_word, out_word; WamWord head_word, body_word; WamWord *end_lst_adr; DEREF(rule_word, word, tag_mask); adr = UnTag_STC(word); if (tag_mask != TAG_STC_MASK || Functor_And_Arity(adr) != dcg_2) return FALSE; top = Local_Top; /* use local stack for the stack */ opt_term_unif = TRUE; head_word = Dcg_Head(Arg(adr, 0), &in_word, &out_word, &end_lst_adr); body_word = Dcg_Body(Arg(adr, 1), FALSE, in_word, out_word, end_lst_adr); Pl_Get_Structure(atom_clause, 2, clause_word); Pl_Unify_Value(head_word); Pl_Unify_Value(body_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_DCG_TRANS_BODY_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Dcg_Trans_Body_4(WamWord dcg_body_word, WamWord in_word, WamWord out_word, WamWord body_word) { top = Local_Top; /* use local stack for the stack */ opt_term_unif = TRUE; in_word = Pl_Globalize_If_In_Local(in_word); out_word = Pl_Globalize_If_In_Local(out_word); return Pl_Unify(body_word, Dcg_Body(dcg_body_word, FALSE, in_word, out_word, NULL)); } /*-------------------------------------------------------------------------* * DCG_HEAD * * * *-------------------------------------------------------------------------*/ static WamWord Dcg_Head(WamWord dcg_head_word, WamWord *in_word, WamWord *out_word, WamWord **end_lst_adr) { WamWord word, tag_mask; WamWord *adr; WamWord *save_H, *p; int func, arity; Bool first; first = TRUE; *end_lst_adr = NULL; start: adr = Pl_Rd_Callable_Check(dcg_head_word, &func, &arity); if (first && arity == 2 && func == ATOM_CHAR(',')) { first = FALSE; dcg_head_word = *adr++; DEREF(*adr, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word != NIL_WORD) { if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, word); *end_lst_adr = UnTag_LST(word); } goto start; } p = save_H = H; *p++ = Functor_Arity(func, arity + 2); while (arity--) *p++ = *adr++; adr = p; *p++ = *in_word = Make_Self_Ref(adr); adr = p; *p++ = *out_word = Make_Self_Ref(adr); H = p; return Tag_STC(save_H); } /*-------------------------------------------------------------------------* * DCG_BODY * * * *-------------------------------------------------------------------------*/ static WamWord Dcg_Body(WamWord dcg_body_word, Bool in_alt, WamWord in_word, WamWord out_word, WamWord *end_lst_adr) { WamWord new_out_word, word; WamWord *save_H, *p; WamWord *save_top = top; Bool save_opt_term_unif = opt_term_unif; Bool opt_equal_between_in_out_vars; WamWord *base; if (end_lst_adr) goto new_out_var; if (in_alt) { top++; new_out_var: new_out_word = Pl_Mk_Variable(); } else new_out_word = out_word; base = top; /* for opt_equal_between_in_out_vars if steadfast is required: * iff last: do not opt (FALSE). Last iff end_lst_adr != NULL */ #if OPT_EQUAL_BETWEEN_IN_OUT_VARS == 0 /* never */ opt_equal_between_in_out_vars = FALSE; #elif OPT_EQUAL_BETWEEN_IN_OUT_VARS == 1 /* always */ opt_equal_between_in_out_vars = TRUE; #else /* steadfast */ opt_equal_between_in_out_vars = (end_lst_adr != NULL); #endif Dcg_Body_On_Stack(dcg_body_word, opt_equal_between_in_out_vars, in_word, new_out_word); if (end_lst_adr) Dcg_Term_List_On_Stack(end_lst_adr, out_word, new_out_word); else if (in_alt) { if (Pl_Blt_Term_Eq(in_word, new_out_word)) *--base = Dcg_Compound2(ATOM_CHAR('='), new_out_word, out_word); else Pl_Unify(new_out_word, out_word); } if (top == base) { word = Tag_ATM(pl_atom_true); goto finish; } word = *--top; while (top > base) { p = save_H = H; *p++ = Functor_Arity(ATOM_CHAR(','), 2); *p++ = *--top; *p++ = word; H = p; word = Tag_STC(save_H); } finish: top = save_top; opt_term_unif = save_opt_term_unif; return word; } /*-------------------------------------------------------------------------* * DCG_BODY_ON_STACK * * * *-------------------------------------------------------------------------*/ static void Dcg_Body_On_Stack(WamWord dcg_body_word, Bool opt_equal_between_in_out_vars, WamWord in_word, WamWord out_word) { WamWord word, tag_mask; WamWord *adr; WamWord w1, w2; WamWord *save_H, *p; int func, arity; DEREF(dcg_body_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { adr = UnTag_REF(word); func = atom_phrase; arity = 1; goto non_term; } if (word == NIL_WORD) { opt_equal_between_in_out_vars = TRUE; /* deactivate to not always optimize [] as unif */ in_is_out: if (opt_equal_between_in_out_vars) Pl_Unify(in_word, out_word); else *top++ = Dcg_Compound2(ATOM_CHAR('='), in_word, out_word); return; } if (tag_mask == TAG_LST_MASK) { Dcg_Term_List_On_Stack(UnTag_LST(word), in_word, out_word); return; } adr = Pl_Rd_Callable_Check(word, &func, &arity); if (arity == 2 && func == ATOM_CHAR(',')) { word = Pl_Mk_Variable(); Dcg_Body_On_Stack(*adr++, OPT_EQUAL_BETWEEN_IN_OUT_VARS != 0, in_word, word); Dcg_Body_On_Stack(*adr, opt_equal_between_in_out_vars, word, out_word); return; } opt_term_unif = FALSE; /* from here opt_term_unif = FALSE */ if (arity == 2 && (func == atom_if || func == atom_soft_if)) { word = Pl_Mk_Variable(); w1 = Dcg_Body(*adr++, FALSE, in_word, word, NULL); w2 = Dcg_Body(*adr, FALSE, word, out_word, NULL); *top++ = Dcg_Compound2(func, w1, w2); return; } if (arity == 2 && (func == ATOM_CHAR(';') || func == ATOM_CHAR('|'))) { w1 = Dcg_Body(*adr++, TRUE, in_word, out_word, NULL); w2 = Dcg_Body(*adr, TRUE, in_word, out_word, NULL); *top++ = Dcg_Compound2(ATOM_CHAR(';'), w1, w2); return; } if (arity == 1 && func == atom_neg) { word = Pl_Mk_Variable(); w1 = Dcg_Body(*adr, FALSE, in_word, word, NULL); *top++ = Dcg_Compound1(func, w1); goto in_is_out; } if (arity == 0 && func == ATOM_CHAR('!')) { *top++ = dcg_body_word; goto in_is_out; } if (arity == 1 && func == pl_atom_curly_brackets) { *top++ = *adr; goto in_is_out; } /* other callable term = non terminal */ non_term: p = save_H = H; *p++ = Functor_Arity(func, arity + 2); while (arity--) *p++ = *adr++; *p++ = in_word; *p++ = out_word; H = p; *top++ = Tag_STC(save_H); } /*-------------------------------------------------------------------------* * DCG_TERM_LIST_ON_STACK * * * *-------------------------------------------------------------------------*/ static void Dcg_Term_List_On_Stack(WamWord *lst_adr, WamWord in_word, WamWord out_word) { WamWord word, tag_mask; WamWord *adr; WamWord *save_lst_adr = lst_adr; WamWord *save_H, *p; p = save_H = H; for (;;) { *p++ = Car(lst_adr); DEREF(Cdr(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, Tag_LST(save_lst_adr)); lst_adr = UnTag_LST(word); adr = p + 1; *p++ = Tag_LST(adr); } *p++ = out_word; H = p; word = Tag_LST(save_H); if (opt_term_unif) Pl_Unify(in_word, word); else { opt_term_unif = TRUE; *top++ = Dcg_Compound2(ATOM_CHAR('='), in_word, word); } } /*-------------------------------------------------------------------------* * DCG_COMPOUND1 * * * *-------------------------------------------------------------------------*/ static WamWord Dcg_Compound1(int func, WamWord w1) { WamWord *save_H, *p; p = save_H = H; *p++ = Functor_Arity(func, 1); *p++ = w1; H = p; return Tag_STC(save_H); } /*-------------------------------------------------------------------------* * DCG_COMPOUND2 * * * *-------------------------------------------------------------------------*/ static WamWord Dcg_Compound2(int func, WamWord w1, WamWord w2) { WamWord *save_H, *p; p = save_H = H; *p++ = Functor_Arity(func, 2); *p++ = w1; *p++ = w2; H = p; return Tag_STC(save_H); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/print.pl�������������������������������������������������������������������0000644�0001750�0001750�00000006545�13021324543�015002� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : print.pl * * Descr.: term print management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_print'. print(Term) :- set_bip_name(print, 1), '$call_c'('Pl_Print_1'(Term)). print(SorA, Term) :- set_bip_name(print, 2), '$call_c'('Pl_Print_2'(SorA, Term)). '$try_portray'(Term) :- '$current_predicate'(portray / 1), g_assign('$portray_ok', 0), '$catch'((portray(Term), !), Err, (format(top_level_output, 'exception from portray/1: ~q~n', [Err]), fail), user, portray, 1), % FIXME Module g_assign('$portray_ok', 1), fail. '$try_portray'(_) :- g_read('$portray_ok', 1). get_print_stream(Stream) :- set_bip_name(get_print_stream, 1), '$check_stream_or_var'(Stream, Stm), '$call_c'('Pl_Get_Print_Stm_1'(Stm)). �����������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/no_sockets.wam�������������������������������������������������������������0000644�0001750�0001750�00000000307�13021356407�016160� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : no_sockets.pl file_name('/home/diaz/GP/src/BipsPl/no_sockets.pl'). predicate(system:'$use_sockets'/0,41,static,private,monofile,built_in,[ proceed]). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pred.wam�������������������������������������������������������������������0000644�0001750�0001750�00000036044�13021356407�014752� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : pred.pl file_name('/home/diaz/GP/src/BipsPl/pred.pl'). predicate(system:'$use_pred'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:current_module/1,43,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_module,1]), execute('$current_module'/1)]). predicate(system:'$current_module'/1,47,static,private,monofile,built_in,[ put_integer(0,1), call_c('Pl_Current_Module_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_module_alt'/0,51,static,private,monofile,built_in,[ call_c('Pl_Current_Module_Alt_0',[boolean],[]), proceed]). predicate(system:'$current_module_relax'/1,57,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(1)), proceed, label(1), trust_me_else_fail, execute('$current_module'/1)]). predicate(system:'$select_module'/3,66,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(4,fail,1,fail,fail), label(1), switch_on_integer([(0,5),(1,2),(2,3)]), label(2), try(7), trust(9), label(3), try(11), retry(13), trust(15), label(4), try_me_else(6), label(5), get_integer(0,0), get_value(x(2),1), proceed, label(6), retry_me_else(8), label(7), get_integer(1,0), get_value(x(2),1), put_value(x(2),0), put_value(x(3),1), execute('$$select_module/3_$aux1'/2), label(8), retry_me_else(10), label(9), get_integer(1,0), get_atom(user,2), proceed, label(10), retry_me_else(12), label(11), get_integer(2,0), get_value(x(2),1), put_atom(user,0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(2),x(0)]), put_atom(system,0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(2),x(0)]), proceed, label(12), retry_me_else(14), label(13), get_integer(2,0), get_atom(user,2), put_atom(system,0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), proceed, label(14), trust_me_else_fail, label(15), get_integer(2,0), get_atom(system,2), proceed]). predicate(system:'$$select_module/3_$aux1'/2,68,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), put_atom(user,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom(system,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), proceed, label(1), trust_me_else_fail, cut(x(1)), proceed]). predicate(system:current_predicate/1,91,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_predicate,1]), put_integer(0,1), put_integer(0,2), execute('$current_predicate'/3)]). predicate(system:'$current_predicate'/1,97,static,private,monofile,built_in,[ put_integer(0,1), put_integer(0,2), execute('$current_predicate'/3)]). predicate(system:'$current_predicate_any'/1,102,static,private,monofile,built_in,[ put_integer(2,1), put_integer(1,2), execute('$current_predicate'/3)]). predicate(system:'$current_predicate'/3,109,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),1), get_variable(y(1),2), put_variable(y(2),1), put_variable(y(3),2), call('$strip_module_var'/3), put_value(y(2),0), call('$current_module_relax'/1), put_value(y(0),0), put_value(y(2),1), put_variable(y(4),2), call('$select_module'/3), put_unsafe_value(y(4),0), put_unsafe_value(y(2),1), put_unsafe_value(y(3),2), put_value(y(1),3), deallocate, call_c('Pl_Current_Predicate_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$current_predicate_alt'/0,119,static,private,monofile,built_in,[ call_c('Pl_Current_Predicate_Alt_0',[boolean],[]), proceed]). predicate(system:predicate_property/2,134,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[predicate_property,2]), put_integer(2,2), put_integer(0,3), execute('$predicate_property'/4)]). predicate(system:'$predicate_property'/2,140,static,private,monofile,built_in,[ put_integer(2,2), put_integer(0,3), execute('$predicate_property'/4)]). predicate(system:'$predicate_property_any'/2,145,static,private,monofile,built_in,[ put_integer(2,2), put_integer(1,3), execute('$predicate_property'/4)]). predicate(system:'$predicate_property'/4,152,static,private,monofile,built_in,[ allocate(8), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_variable(y(3),1), put_variable(y(4),2), call('$strip_module_var'/3), put_value(y(3),0), call('$current_module_relax'/1), put_value(y(1),0), put_value(y(3),1), put_variable(y(5),2), call('$select_module'/3), put_value(y(4),0), put_variable(y(6),1), put_variable(y(7),2), call('$head_to_fn'/3), put_unsafe_value(y(5),0), put_unsafe_value(y(3),1), put_structure((/)/2,2), unify_local_value(y(6)), unify_local_value(y(7)), put_value(y(2),3), call_c('Pl_Current_Predicate_4',[boolean],[x(0),x(1),x(2),x(3)]), put_unsafe_value(y(4),0), put_unsafe_value(y(6),1), put_unsafe_value(y(7),2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_unsafe_value(y(5),0), put_unsafe_value(y(6),1), put_unsafe_value(y(7),2), put_value(y(0),3), put_unsafe_value(y(3),4), deallocate, execute('$$predicate_property/4_$aux1'/5)]). predicate(system:'$$predicate_property/4_$aux1'/5,152,static,private,monofile,local,[ try_me_else(1), execute('$predicate_property1'/4), label(1), trust_me_else_fail, call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(4),x(0)]), get_structure(imported_from/1,3), unify_local_value(x(0)), proceed]). predicate(system:'$head_to_fn'/3,166,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(3)), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), proceed, label(1), retry_me_else(2), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), proceed, label(2), trust_me_else_fail, put_value(x(0),1), put_atom(callable,0), execute('$pl_err_type'/2)]). predicate(system:'$predicate_property1'/3,181,static,private,monofile,built_in,[ get_variable(x(3),2), get_variable(x(2),1), put_value(x(0),1), put_atom(system,0), execute('$predicate_property1'/4)]). predicate(system:'$predicate_property1'/4,187,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_value(y(3),0), call('$check_pred_prop'/1), cut(y(4)), put_value(y(3),0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), deallocate, execute('$predicate_property2'/4)]). predicate(system:'$check_pred_prop'/1,194,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), retry_me_else(34), switch_on_term(4,2,fail,fail,3), label(2), switch_on_atom([(static,5),((dynamic),7),(private,9),((public),11),(monofile,13),((multifile),15),(user,17),(built_in,19),(built_in_fd,21),(control_construct,23),(native_code,25)]), label(3), switch_on_structure([(prolog_file/1,27),(prolog_line/1,29),((meta_predicate)/1,31),(imported_from/1,33)]), label(4), try_me_else(6), label(5), get_atom(static,0), proceed, label(6), retry_me_else(8), label(7), get_atom(dynamic,0), proceed, label(8), retry_me_else(10), label(9), get_atom(private,0), proceed, label(10), retry_me_else(12), label(11), get_atom(public,0), proceed, label(12), retry_me_else(14), label(13), get_atom(monofile,0), proceed, label(14), retry_me_else(16), label(15), get_atom(multifile,0), proceed, label(16), retry_me_else(18), label(17), get_atom(user,0), proceed, label(18), retry_me_else(20), label(19), get_atom(built_in,0), proceed, label(20), retry_me_else(22), label(21), get_atom(built_in_fd,0), proceed, label(22), retry_me_else(24), label(23), get_atom(control_construct,0), proceed, label(24), retry_me_else(26), label(25), get_atom(native_code,0), proceed, label(26), retry_me_else(28), label(27), get_structure(prolog_file/1,0), unify_void(1), proceed, label(28), retry_me_else(30), label(29), get_structure(prolog_line/1,0), unify_void(1), proceed, label(30), retry_me_else(32), label(31), get_structure((meta_predicate)/1,0), unify_void(1), proceed, label(32), trust_me_else_fail, label(33), get_structure(imported_from/1,0), unify_void(1), proceed, label(34), trust_me_else_fail, put_value(x(0),1), put_atom(predicate_property,0), execute('$pl_err_domain'/2)]). predicate(system:'$predicate_property2'/4,233,static,private,monofile,built_in,[ switch_on_term(3,1,fail,fail,2), label(1), switch_on_atom([(static,4),((dynamic),6),(private,8),((public),10),(monofile,12),((multifile),14),(user,16),(built_in,18),(built_in_fd,20),(control_construct,22),(native_code,24)]), label(2), switch_on_structure([(prolog_file/1,26),(prolog_line/1,28),((meta_predicate)/1,30)]), label(3), try_me_else(5), label(4), get_atom(static,0), call_c('Pl_Pred_Prop_Static_2',[boolean],[x(1),x(2),x(3)]), proceed, label(5), retry_me_else(7), label(6), get_atom(dynamic,0), call_c('Pl_Pred_Prop_Dynamic_2',[boolean],[x(1),x(2),x(3)]), proceed, label(7), retry_me_else(9), label(8), get_atom(private,0), call_c('Pl_Pred_Prop_Private_2',[boolean],[x(1),x(2),x(3)]), proceed, label(9), retry_me_else(11), label(10), get_atom(public,0), call_c('Pl_Pred_Prop_Public_2',[boolean],[x(1),x(2),x(3)]), proceed, label(11), retry_me_else(13), label(12), get_atom(monofile,0), call_c('Pl_Pred_Prop_Monofile_2',[boolean],[x(1),x(2),x(3)]), proceed, label(13), retry_me_else(15), label(14), get_atom(multifile,0), call_c('Pl_Pred_Prop_Multifile_2',[boolean],[x(1),x(2),x(3)]), proceed, label(15), retry_me_else(17), label(16), get_atom(user,0), call_c('Pl_Pred_Prop_User_2',[boolean],[x(1),x(2),x(3)]), proceed, label(17), retry_me_else(19), label(18), get_atom(built_in,0), call_c('Pl_Pred_Prop_Built_In_2',[boolean],[x(1),x(2),x(3)]), proceed, label(19), retry_me_else(21), label(20), get_atom(built_in_fd,0), call_c('Pl_Pred_Prop_Built_In_Fd_2',[boolean],[x(1),x(2),x(3)]), proceed, label(21), retry_me_else(23), label(22), get_atom(control_construct,0), call_c('Pl_Pred_Prop_Control_Construct_2',[boolean],[x(1),x(2),x(3)]), proceed, label(23), retry_me_else(25), label(24), get_atom(native_code,0), call_c('Pl_Pred_Prop_Native_Code_2',[boolean],[x(1),x(2),x(3)]), proceed, label(25), retry_me_else(27), label(26), get_structure(prolog_file/1,0), unify_variable(x(0)), call_c('Pl_Pred_Prop_Prolog_File_3',[boolean],[x(1),x(2),x(3),x(0)]), proceed, label(27), retry_me_else(29), label(28), get_structure(prolog_line/1,0), unify_variable(x(0)), call_c('Pl_Pred_Prop_Prolog_Line_3',[boolean],[x(1),x(2),x(3),x(0)]), proceed, label(29), trust_me_else_fail, label(30), get_structure((meta_predicate)/1,0), unify_variable(x(0)), call_c('Pl_Pred_Prop_Meta_Predicate_3',[boolean],[x(1),x(2),x(3),x(0)]), proceed]). predicate(system:'$get_predicate_file_info'/5,278,static,private,monofile,built_in,[ call_c('Pl_Get_Predicate_File_Info_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:'$set_predicate_file_info'/5,284,static,private,monofile,built_in,[ call_c('Pl_Set_Predicate_File_Info_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:'$get_module_of_pred'/4,290,static,private,monofile,built_in,[ call_c('Pl_Get_Module_Of_Pred_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$get_module_of_goal'/3,294,static,private,monofile,built_in,[ call_c('Pl_Get_Module_Of_Goal_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$get_module_of_goal_if_not_meta_pred'/3,297,static,private,monofile,built_in,[ call_c('Pl_Get_Module_Of_Goal_If_Not_Meta_Pred_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$aux_name'/1,304,static,private,monofile,built_in,[ call_c('Pl_Aux_Name_1',[boolean],[x(0)]), proceed]). predicate(system:'$father_of_aux_name'/3,310,static,private,monofile,built_in,[ call_c('Pl_Father_Of_Aux_Name_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$pred_without_aux'/4,316,static,private,monofile,built_in,[ call_c('Pl_Pred_Without_Aux_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$make_aux_name'/4,322,static,private,monofile,built_in,[ call_c('Pl_Make_Aux_Name_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:'$declare_meta_predicate'/2,327,static,private,monofile,built_in,[ call_c('Pl_Decl_Meta_Pred_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:strip_module/3,333,static,private,monofile,built_in,[ call_c('Pl_Strip_Module_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$strip_module_var'/3,337,static,private,monofile,built_in,[ call_c('Pl_Strip_Module_Var_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$strip_module_nonvar'/3,341,static,private,monofile,built_in,[ call_c('Pl_Strip_Module_Nonvar_3',[boolean],[x(0),x(1),x(2)]), proceed]). directive(89,system,[ put_atom(user,0), put_structure(current_predicate/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(95,system,[ put_atom(user,0), put_structure('$current_predicate'/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(100,system,[ put_atom(user,0), put_structure('$current_predicate_any'/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(132,system,[ put_atom(user,0), put_structure(predicate_property/2,1), unify_atom(:), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(138,system,[ put_atom(user,0), put_structure('$predicate_property'/2,1), unify_atom(:), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(143,system,[ put_atom(user,0), put_structure('$predicate_property_any'/2,1), unify_atom(:), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(331,system,[ put_atom(user,0), put_structure(strip_module/3,1), unify_atom(:), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/BYTE_CODE������������������������������������������������������������������0000644�0001750�0001750�00000007122�13021324543�014561� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Here is the detail of the byte-code encoding The first word is always a 32-bits word. atm32 is a 32-bits words on any machine (an int = index in the atom table). mod32 is the same as atm32 (or mod24 = cst24) dbl64 is always a 64-bits word on any machine. int32 or int64 is a 32-bits word on a 32-bits machine, a 64-bits word on a 64-bits machine. adr32 or adr64 is a 32-bits address on a 32-bits machine, a 64-bits word on a 64-bits machine. There a 2 formats for the first 32-bits word: format 1 | i16 | i8 | op8| see macros prefixed by BC1_... format 2 | i24 | op8| see macros prefixed by BC2_... Here is the instruction encoding GET_X_VARIABLE | x | x | op | GET_Y_VARIABLE | y | x | op | GET_X_VALUE | x | x | op | GET_Y_VALUE | y | x | op | GET_ATOM | cst16 | x | op | GET_ATOM_BIG | ------- | x | op | | atm32 | GET_INTEGER | int16 | x | op | GET_INTEGER_BIG | ------- | x | op | | int32 or int64 | GET_FLOAT | ------- | x | op | | dbl64 | GET_NIL | ------- | x | op | GET_LIST | ------- | x | op | GET_STRUCTURE | arity | x | op | | fun32 | PUT_X_VARIABLE | x | x | op | PUT_Y_VARIABLE | y | x | op | PUT_VOID | ------- | x | op | PUT_X_VALUE | x | x | op | PUT_Y_VALUE | y | x | op | PUT_Y_UNSAFE_VALUE | y | x | op | PUT_ATOM | cst16 | x | op | PUT_ATOM_BIG | ------- | x | op | | atm32 | PUT_INTEGER | int16 | x | op | PUT_INTEGER_BIG | ------- | x | op | | int32 or int64 | PUT_FLOAT | ------- | x | op | | dbl64 | PUT_NIL | ------- | x | op | PUT_LIST | ------- | x | op | PUT_STRUCTURE | arity | x | op | | fun32 | PUT_META_TERM | x | x | op | | mod32 | MATH_LOAD_X_VALUE | x | x | op | MATH_LOAD_Y_VALUE | y | x | op | UNIFY_X_VARIABLE | x | op | UNIFY_Y_VARIABLE | y | op | UNIFY_VOID | int24 | op | UNIFY_X_VALUE | x | op | UNIFY_Y_VALUE | y | op | UNIFY_X_LOCAL_VALUE | x | op | UNIFY_Y_LOCAL_VALUE | y | op | UNIFY_ATOM | cst24 | op | UNIFY_ATOM_BIG | ------------ | op | | atm32 | useless while nb of atoms < 2^24 UNIFY_INTEGER | int24 | op | UNIFY_INTEGER_BIG | ------------ | op | | int32 or int64 | UNIFY_NIL | ------------ | op | UNIFY_LIST | ------------ | op | UNIFY_STRUCTURE | arity | op | | fun32 | ALLOCATE | int24 | op | DEALLOCATE | ------------ | op | CALL | mod24 | op | | f/n32 | | f/n32 | (f/n of the caller) CALL_NATIVE | mod24 | op | | f/n32 | | adr32 or adr64 | EXECUTE | mod24 | op | | f/n32 | | f/n32 | (f/n of the caller) EXECUTE_NATIVE | mod24 | op | | f/n32 | | adr32 or adr64 | PROCEED | ------------ | op | FAIL | ------------ | op | GET_CURRENT_CHOICE_X | x | op | GET_CURRENT_CHOICE_Y | y | op | CUT_X | x | op | CUT_Y | y | op | SOFT_CUT_X | x | op | SOFT_CUT_Y | y | op | ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stream_c.c�����������������������������������������������������������������0000644�0001750�0001750�00000126045�13021324543�015250� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : stream_c.c * * Descr.: stream selection and control management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <errno.h> #include <string.h> #include <fcntl.h> #include "engine_pl.h" #include "bips_pl.h" #ifndef NO_USE_LINEDIT #include "linedit.h" #endif #if defined(_WIN32) || defined(__CYGWIN__) #include <io.h> #endif #ifndef _WIN32 #include <unistd.h> #include <sys/fcntl.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ #define TERM_STREAM_WRITE_BLOCK 1024 /* Error Messages */ #define ERR_NEEDS_SPECIAL_CLOSE "special stream: needs appropriate close predicate" #define ERR_CANNOT_CLOSE_STREAM "cannot close stream" /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { int buff_size; Bool buff_is_alloc; char *buff; char *ptr; } TermSInf; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define CURRENT_STREAM_ALT X1_2463757272656E745F73747265616D5F616C74 #define CURRENT_ALIAS_ALT X1_2463757272656E745F616C6961735F616C74 #define CURRENT_MIRROR_ALT X1_2463757272656E745F6D6972726F725F616C74 Prolog_Prototype(CURRENT_STREAM_ALT, 0); Prolog_Prototype(CURRENT_ALIAS_ALT, 0); Prolog_Prototype(CURRENT_MIRROR_ALT, 0); /*-------------------------------------------------------------------------* * PL_CURRENT_INPUT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Input_1(WamWord stm_word) { return Pl_Get_Integer(pl_stm_input, stm_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_OUTPUT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Output_1(WamWord stm_word) { return Pl_Get_Integer(pl_stm_output, stm_word); } /*-------------------------------------------------------------------------* * PL_SET_INPUT_1 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Input_1(WamWord sora_word) { pl_stm_input = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); } /*-------------------------------------------------------------------------* * PL_SET_OUTPUT_1 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Output_1(WamWord sora_word) { pl_stm_output = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); } /*-------------------------------------------------------------------------* * PL_SET_TOP_LEVEL_STREAMS_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Top_Level_Streams_2(WamWord sora_in_word, WamWord sora_out_word) { pl_stm_top_level_input = Pl_Get_Stream_Or_Alias(sora_in_word, STREAM_CHECK_INPUT); pl_stm_top_level_output = Pl_Get_Stream_Or_Alias(sora_out_word, STREAM_CHECK_OUTPUT); Pl_Reassign_Alias(pl_atom_top_level_input, pl_stm_top_level_input); Pl_Reassign_Alias(pl_atom_top_level_output, pl_stm_top_level_output); } /*-------------------------------------------------------------------------* * PL_SET_DEBUGGER_STREAMS_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Debugger_Streams_2(WamWord sora_in_word, WamWord sora_out_word) { pl_stm_debugger_input = Pl_Get_Stream_Or_Alias(sora_in_word, STREAM_CHECK_INPUT); pl_stm_debugger_output = Pl_Get_Stream_Or_Alias(sora_out_word, STREAM_CHECK_OUTPUT); Pl_Reassign_Alias(pl_atom_debugger_input, pl_stm_debugger_input); Pl_Reassign_Alias(pl_atom_debugger_output, pl_stm_debugger_output); } /*-------------------------------------------------------------------------* * PL_OPEN_3 * * * *-------------------------------------------------------------------------*/ void Pl_Open_3(WamWord source_sink_word, WamWord mode_word, WamWord stm_word) { WamWord word, tag_mask; int atom; int mode = STREAM_MODE_READ; /* to avoid clang warning */ Bool text; StmProp prop; char *path; int atom_file_name; int stm; FILE *f; int mask = SYS_VAR_OPTION_MASK; Bool reposition; DEREF(source_sink_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_ATM_MASK) Pl_Err_Domain(pl_domain_source_sink, source_sink_word); atom_file_name = UnTag_ATM(word); path = pl_atom_tbl[atom_file_name].name; if ((path = Pl_M_Absolute_Path_Name(path)) == NULL) Pl_Err_Existence(pl_existence_source_sink, source_sink_word); text = mask & 1; mask >>= 1; atom = Pl_Rd_Atom_Check(mode_word); if (atom == pl_atom_read) mode = STREAM_MODE_READ; else if (atom == pl_atom_write) mode = STREAM_MODE_WRITE; else if (atom == pl_atom_append) mode = STREAM_MODE_APPEND; else Pl_Err_Domain(pl_domain_io_mode, mode_word); stm = Pl_Add_Stream_For_Stdio_File(path, mode, text); if (stm < 0) { if (errno == ENOENT || errno == ENOTDIR) Pl_Err_Existence(pl_existence_source_sink, source_sink_word); else Pl_Err_Permission(pl_permission_operation_open, pl_permission_type_source_sink, source_sink_word); } prop = pl_stm_tbl[stm]->prop; f = (FILE *) pl_stm_tbl[stm]->file; /* change properties wrt to specified ones */ if ((mask & 2) != 0) /* reposition specified */ { reposition = mask & 1; if (reposition && !prop.reposition) { fclose(f); word = Pl_Put_Structure(pl_atom_reposition, 1); Pl_Unify_Atom(pl_atom_true); Pl_Err_Permission(pl_permission_operation_open, pl_permission_type_source_sink, word); } prop.reposition = reposition; } mask >>= 2; if ((mask & 4) != 0) /* eof_action specified */ prop.eof_action = mask & 3; mask >>= 3; if ((mask & 4) != 0) /* buffering specified */ if (prop.buffering != (unsigned) (mask & 3)) /* cast for MSVC warning */ { prop.buffering = mask & 3; Pl_Stdio_Set_Buffering(f, prop.buffering); } mask >>= 3; pl_stm_tbl[stm]->atom_file_name = atom_file_name; pl_stm_tbl[stm]->prop = prop; Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_TEST_ALIAS_NOT_ASSIGNED_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Test_Alias_Not_Assigned_1(WamWord alias_word) { return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(alias_word)) < 0; } /*-------------------------------------------------------------------------* * PL_FROM_ALIAS_TO_STREAM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_From_Alias_To_Stream_2(WamWord alias_word, WamWord stm_word) { int stm; stm = Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(alias_word)); return stm >= 0 && Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_ADD_STREAM_ALIAS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Add_Stream_Alias_2(WamWord sora_word, WamWord alias_word) { int stm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); return Pl_Add_Alias_To_Stream(Pl_Rd_Atom_Check(alias_word), stm); } /*-------------------------------------------------------------------------* * PL_CHECK_VALID_MIRROR_1 * * * *-------------------------------------------------------------------------*/ void Pl_Check_Valid_Mirror_1(WamWord mirror_word) { Pl_Get_Stream_Or_Alias(mirror_word, STREAM_CHECK_OUTPUT); } /*-------------------------------------------------------------------------* * PL_ADD_STREAM_MIRROR_2 * * * *-------------------------------------------------------------------------*/ void Pl_Add_Stream_Mirror_2(WamWord sora_word, WamWord mirror_word) { int stm; int m_stm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); m_stm = Pl_Get_Stream_Or_Alias(mirror_word, STREAM_CHECK_OUTPUT); Pl_Add_Mirror_To_Stream(stm, m_stm); } /*-------------------------------------------------------------------------* * PL_REMOVE_STREAM_MIRROR_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Remove_Stream_Mirror_2(WamWord sora_word, WamWord mirror_word) { int stm; int m_stm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); m_stm = Pl_Get_Stream_Or_Alias(mirror_word, STREAM_CHECK_EXIST); return Pl_Del_Mirror_From_Stream(stm, m_stm); } /*-------------------------------------------------------------------------* * PL_SET_STREAM_TYPE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Stream_Type_2(WamWord sora_word, WamWord is_text_word) { int stm; StmInf *pstm; int text; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; text = Pl_Rd_Integer_Check(is_text_word); if ((unsigned) text == pstm->prop.text) return; if (pstm->char_count) Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_stream, sora_word); pstm->prop.text = text; #if defined(_WIN32) || defined(__CYGWIN__) { FILE *f; f = Pl_Stdio_Desc_Of_Stream(stm); if (f == NULL) return; setmode(fileno(f), (text) ? O_TEXT : O_BINARY); } #endif } /*-------------------------------------------------------------------------* * PL_SET_STREAM_EOF_ACTION_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Stream_Eof_Action_2(WamWord sora_word, WamWord action_word) { int stm; StmInf *pstm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (pstm->prop.output) Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_stream, sora_word); pstm->prop.eof_action = Pl_Rd_Integer_Check(action_word); } /*-------------------------------------------------------------------------* * PL_SET_STREAM_BUFFERING_2 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Stream_Buffering_2(WamWord sora_word, WamWord buff_mode_word) { int stm; StmInf *pstm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; pstm->prop.buffering = Pl_Rd_Integer_Check(buff_mode_word); Pl_Set_Stream_Buffering(stm); } /*-------------------------------------------------------------------------* * PL_CLOSE_1 * * * *-------------------------------------------------------------------------*/ void Pl_Close_1(WamWord sora_word) { int stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); Pl_Close_Stm(stm, SYS_VAR_OPTION_MASK & 1); } /*-------------------------------------------------------------------------* * PL_CLOSE_STM * * * *-------------------------------------------------------------------------*/ void Pl_Close_Stm(int stm, Bool force) { StmInf *pstm = pl_stm_tbl[stm]; int fd = 0; Pl_Stream_Flush(pstm); if (stm == pl_stm_stdin || stm == pl_stm_stdout) return; if (stm == pl_stm_top_level_input || stm == pl_stm_top_level_output) return; if (stm == pl_stm_debugger_input || stm == pl_stm_debugger_output) return; if (stm == pl_stm_input) pl_stm_input = pl_stm_stdin; else if (stm == pl_stm_output) pl_stm_output = pl_stm_stdout; if (pstm->prop.special_close) Pl_Err_System(Pl_Create_Atom(ERR_NEEDS_SPECIAL_CLOSE)); if (pstm->fct_close == fclose) fd = fileno((FILE *) (pstm->file)); if (Pl_Stream_Close(pstm) != 0) { if (force == 0) Pl_Err_System(Pl_Create_Atom(ERR_CANNOT_CLOSE_STREAM)); /* else force close */ if (fd > 2) close(fd); } Pl_Delete_Stream(stm); } /*-------------------------------------------------------------------------* * PL_PB_EMPTY_BUFFER_1 * * * *-------------------------------------------------------------------------*/ void Pl_PB_Empty_Buffer_1(WamWord sora_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); Pl_PB_Empty_Buffer(pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_FLUSH_OUTPUT_1 * * * *-------------------------------------------------------------------------*/ void Pl_Flush_Output_1(WamWord sora_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pl_last_output_sora = sora_word; Pl_Stream_Flush(pl_stm_tbl[stm]); } /*-------------------------------------------------------------------------* * PL_FLUSH_OUTPUT_0 * * * *-------------------------------------------------------------------------*/ void Pl_Flush_Output_0(void) { Pl_Flush_Output_1(NOT_A_WAM_WORD); } /*-------------------------------------------------------------------------* * PL_CURRENT_STREAM_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Stream_1(WamWord stm_word) { WamWord word, tag_mask; int stm = 0; DEREF(stm_word, word, tag_mask); /* either an INT or a REF */ if (tag_mask == TAG_INT_MASK) { stm = UnTag_INT(word); return (stm >= 0 && stm <= pl_stm_last_used && pl_stm_tbl[stm] != NULL); } for (; stm <= pl_stm_last_used; stm++) if (pl_stm_tbl[stm]) break; if (stm >= pl_stm_last_used) { if (stm > pl_stm_last_used) return FALSE; } else /* non deterministic case */ { A(0) = stm_word; A(1) = stm + 1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_STREAM_ALT, 0), 2); } return Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_STREAM_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Stream_Alt_0(void) { WamWord stm_word; int stm; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_STREAM_ALT, 0), 0); stm_word = AB(B, 0); stm = AB(B, 1); for (; stm <= pl_stm_last_used; stm++) if (pl_stm_tbl[stm]) break; if (stm >= pl_stm_last_used) { Delete_Last_Choice_Point(); if (stm > pl_stm_last_used) return FALSE; } else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = stm_word; #endif AB(B, 1) = stm + 1; } return Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_FILE_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_File_Name_2(WamWord file_name_word, WamWord stm_word) { int stm; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ return Pl_Un_Atom_Check(pl_stm_tbl[stm]->atom_file_name, file_name_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_MODE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Mode_2(WamWord mode_word, WamWord stm_word) { int stm; int atom; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ switch (pl_stm_tbl[stm]->prop.mode) { case STREAM_MODE_READ: atom = pl_atom_read; break; case STREAM_MODE_WRITE: atom = pl_atom_write; break; case STREAM_MODE_APPEND: atom = pl_atom_append; break; } return Pl_Un_Atom_Check(atom, mode_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_INPUT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Input_1(WamWord stm_word) { int stm; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ return pl_stm_tbl[stm]->prop.input; } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_OUTPUT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Output_1(WamWord stm_word) { int stm; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ return pl_stm_tbl[stm]->prop.output; } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_TYPE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Type_2(WamWord type_word, WamWord stm_word) { int stm; int atom; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ atom = (pl_stm_tbl[stm]->prop.text) ? pl_atom_text : pl_atom_binary; return Pl_Un_Atom_Check(atom, type_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_REPOSITION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Reposition_2(WamWord reposition_word, WamWord stm_word) { int stm; int atom; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ atom = (pl_stm_tbl[stm]->prop.reposition) ? pl_atom_true : pl_atom_false; return Pl_Un_Atom_Check(atom, reposition_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_EOF_ACTION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Eof_Action_2(WamWord eof_action_word, WamWord stm_word) { int stm; int atom; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ switch (pl_stm_tbl[stm]->prop.eof_action) { case STREAM_EOF_ACTION_ERROR: atom = pl_atom_error; break; case STREAM_EOF_ACTION_EOF_CODE: atom = pl_atom_eof_code; break; case STREAM_EOF_ACTION_RESET: atom = pl_atom_reset; break; } return Pl_Un_Atom_Check(atom, eof_action_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_BUFFERING_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_Buffering_2(WamWord buffering_word, WamWord stm_word) { int stm; int atom; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ #ifndef NO_USE_LINEDIT /* if GUI: ask it for buffering */ if (pl_stm_tbl[stm]->file == (PlLong) stdout && pl_le_hook_get_line_buffering) { if ((*pl_le_hook_get_line_buffering)()) pl_stm_tbl[stm]->prop.buffering = STREAM_BUFFERING_LINE; else pl_stm_tbl[stm]->prop.buffering = STREAM_BUFFERING_NONE; } #endif switch (pl_stm_tbl[stm]->prop.buffering) { case STREAM_BUFFERING_NONE: atom = pl_atom_none; break; case STREAM_BUFFERING_LINE: atom = pl_atom_line; break; case STREAM_BUFFERING_BLOCK: atom = pl_atom_block; break; } return Pl_Un_Atom_Check(atom, buffering_word); } /*-------------------------------------------------------------------------* * PL_STREAM_PROP_END_OF_STREAM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Prop_End_Of_Stream_2(WamWord end_of_stream_word, WamWord stm_word) { int stm; int atom; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ switch (Pl_Stream_End_Of_Stream(pl_stm_tbl[stm])) { case STREAM_EOF_NOT: atom = pl_atom_not; break; case STREAM_EOF_AT: atom = pl_atom_at; break; case STREAM_EOF_PAST: atom = pl_atom_past; break; } return Pl_Un_Atom_Check(atom, end_of_stream_word); } /*-------------------------------------------------------------------------* * PL_AT_END_OF_STREAM_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_At_End_Of_Stream_1(WamWord sora_word) { int stm; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_input : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_INPUT); return Pl_Stream_End_Of_Stream(pl_stm_tbl[stm]) != STREAM_EOF_NOT; } /*-------------------------------------------------------------------------* * PL_AT_END_OF_STREAM_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_At_End_Of_Stream_0(void) { return Pl_At_End_Of_Stream_1(NOT_A_WAM_WORD); } /*-------------------------------------------------------------------------* * PL_CURRENT_ALIAS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Alias_2(WamWord stm_word, WamWord alias_word) { WamWord word, tag_mask; int stm; HashScan scan; AliasInf *alias; AliasInf *save_alias; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ DEREF(alias_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(word)) == stm; for (alias = (AliasInf *) Pl_Hash_First(pl_alias_tbl, &scan); alias; alias = (AliasInf *) Pl_Hash_Next(&scan)) if (alias->stm == stm) break; if (alias == NULL) return FALSE; save_alias = alias; for (;;) { alias = (AliasInf *) Pl_Hash_Next(&scan); if (alias == NULL || alias->stm == stm) break; } if (alias) /* non deterministic case */ { A(0) = stm; A(1) = alias_word; A(2) = (WamWord) scan.endt; A(3) = (WamWord) scan.cur_t; A(4) = (WamWord) scan.cur_p; A(5) = (WamWord) alias; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ALIAS_ALT, 0), 6); } Pl_Get_Atom(save_alias->atom, alias_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_CURRENT_ALIAS_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Alias_Alt_0(void) { int stm; WamWord alias_word; HashScan scan; AliasInf *alias; AliasInf *save_alias; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ALIAS_ALT, 0), 0); stm = AB(B, 0); alias_word = AB(B, 1); scan.endt = (char *) AB(B, 2); scan.cur_t = (char *) AB(B, 3); scan.cur_p = (char *) AB(B, 4); alias = (AliasInf *) AB(B, 5); save_alias = alias; for (;;) { alias = (AliasInf *) Pl_Hash_Next(&scan); if (alias == NULL || alias->stm == stm) break; } if (alias) /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = stm; AB(B, 1) = alias_word; AB(B, 2) = (WamWord) scan.endt; #endif AB(B, 3) = (WamWord) scan.cur_t; AB(B, 4) = (WamWord) scan.cur_p; AB(B, 5) = (WamWord) alias; } else Delete_Last_Choice_Point(); Pl_Get_Atom(save_alias->atom, alias_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_CURRENT_MIRROR_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Mirror_2(WamWord stm_word, WamWord m_stm_word) { int stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ StmInf *pstm = pl_stm_tbl[stm]; StmLst *m = pstm->mirror; /* From here, the code also works with */ /* m = m_pstm->mirror_of. Could be used */ /* if m_stm_word is given and not stm_word */ if (m == NULL) return FALSE; if (m->next != NULL) /* non deterministic case */ { A(0) = stm; /* useless in fact */ A(1) = m_stm_word; A(2) = (WamWord) m->next; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MIRROR_ALT, 0), 3); } return Pl_Get_Integer(m->stm, m_stm_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_MIRROR_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Mirror_Alt_0(void) { /* int stm; */ WamWord m_stm_word; StmLst *m; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MIRROR_ALT, 0), 0); /* stm = AB(B, 0); */ m_stm_word = AB(B, 1); m = (StmLst *) AB(B, 2); if (m->next) /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = stm; AB(B, 1) = m_stm_word; #endif AB(B, 2) = (WamWord) m->next; } else Delete_Last_Choice_Point(); return Pl_Get_Integer(m->stm, m_stm_word); } /*-------------------------------------------------------------------------* * PL_STREAM_POSITION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Position_2(WamWord sora_word, WamWord position_word) { WamWord word, tag_mask; WamWord p_word[4]; PlLong p[4]; int i; int stm; StmInf *pstm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; Pl_Stream_Get_Position(pstm, p, p + 1, p + 2, p + 3); if (!Pl_Get_Structure(pl_atom_stream_position, 4, position_word)) dom_error: Pl_Err_Domain(pl_domain_stream_position, position_word); for (i = 0; i < 4; i++) { p_word[i] = Pl_Unify_Variable(); DEREF(p_word[i], word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_INT_MASK) goto dom_error; } for (i = 0; i < 4; i++) if (!Pl_Get_Integer(p[i], p_word[i])) return FALSE; return TRUE; } /*-------------------------------------------------------------------------* * PL_SET_STREAM_POSITION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Set_Stream_Position_2(WamWord sora_word, WamWord position_word) { WamWord word, tag_mask; WamWord p_word[4]; int p[4]; int i; int stm; StmInf *pstm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.reposition) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_stream, sora_word); DEREF(position_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (!Pl_Get_Structure(pl_atom_stream_position, 4, position_word)) dom_error: Pl_Err_Domain(pl_domain_stream_position, position_word); for (i = 0; i < 4; i++) { p_word[i] = Pl_Unify_Variable(); DEREF(p_word[i], word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) goto dom_error; p[i] = UnTag_INT(word); } return Pl_Stream_Set_Position(pstm, SEEK_SET, p[0], p[1], p[2], p[3]) == 0; } /*-------------------------------------------------------------------------* * PL_SEEK_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Seek_4(WamWord sora_word, WamWord whence_word, WamWord offset_word, WamWord new_loc_word) { int stm; StmInf *pstm; int whence = SEEK_SET; /* to avoid clang warning */ PlLong offset; int atom; PlLong p[4]; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.reposition) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_stream, sora_word); if (pstm->prop.text) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_text_stream, sora_word); atom = Pl_Rd_Atom_Check(whence_word); if (atom == pl_atom_bof) whence = SEEK_SET; else if (atom == pl_atom_current) whence = SEEK_CUR; else if (atom == pl_atom_eof) whence = SEEK_END; else Pl_Err_Domain(pl_domain_stream_seek_method, whence_word); offset = Pl_Rd_Integer_Check(offset_word); Pl_Check_For_Un_Integer(new_loc_word); if (Pl_Stream_Set_Position(pstm, whence, offset, offset, 0, 0) != 0) return FALSE; Pl_Stream_Get_Position(pstm, &offset, p + 1, p + 2, p + 3); return Pl_Get_Integer(offset, new_loc_word); } /*-------------------------------------------------------------------------* * PL_CHARACTER_COUNT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Character_Count_2(WamWord sora_word, WamWord count_word) { int stm; StmInf *pstm; PlLong offset, char_count, line_count, line_pos; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; Pl_Stream_Get_Position(pstm, &offset, &char_count, &line_count, &line_pos); return Pl_Un_Integer_Check(char_count, count_word); } /*-------------------------------------------------------------------------* * PL_LINE_COUNT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Line_Count_2(WamWord sora_word, WamWord count_word) { int stm; StmInf *pstm; PlLong offset, char_count, line_count, line_pos; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.text) Pl_Err_Permission(pl_permission_operation_access, pl_permission_type_binary_stream, sora_word); Pl_Stream_Get_Position(pstm, &offset, &char_count, &line_count, &line_pos); return Pl_Un_Integer_Check(line_count, count_word); } /*-------------------------------------------------------------------------* * PL_LINE_POSITION_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Line_Position_2(WamWord sora_word, WamWord count_word) { int stm; StmInf *pstm; PlLong offset, char_count, line_count, line_pos; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.text) Pl_Err_Permission(pl_permission_operation_access, pl_permission_type_binary_stream, sora_word); Pl_Stream_Get_Position(pstm, &offset, &char_count, &line_count, &line_pos); return Pl_Un_Integer_Check(line_pos, count_word); } /*-------------------------------------------------------------------------* * PL_STREAM_LINE_COLUMN_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Stream_Line_Column_3(WamWord sora_word, WamWord line_word, WamWord col_word) { int stm; StmInf *pstm; PlLong offset, char_count, line_count, line_pos; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.text) Pl_Err_Permission(pl_permission_operation_access, pl_permission_type_binary_stream, sora_word); Pl_Stream_Get_Position(pstm, &offset, &char_count, &line_count, &line_pos); return Pl_Un_Integer_Check(line_count + 1, line_word) && Pl_Un_Integer_Check(line_pos + 1, col_word); } /*-------------------------------------------------------------------------* * PL_SET_STREAM_LINE_COLUMN_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Set_Stream_Line_Column_3(WamWord sora_word, WamWord line_word, WamWord col_word) { int stm; StmInf *pstm; PlLong line_count, line_pos; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.reposition) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_stream, sora_word); if (!pstm->prop.text) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_binary_stream, sora_word); line_count = Pl_Rd_Integer_Check(line_word) - 1; line_pos = Pl_Rd_Integer_Check(col_word) - 1; return line_count >= 0 && line_pos >= 0 && Pl_Stream_Set_Position_LC(pstm, line_count, line_pos) == 0; } /*-------------------------------------------------------------------------* * Operations on term_streams * * * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_OPEN_INPUT_TERM_STREAM_2 * * * *-------------------------------------------------------------------------*/ void Pl_Open_Input_Term_Stream_2(WamWord sink_term_word, WamWord stm_word) { char *str; int stm; int n; if (SYS_VAR_OPTION_MASK == TERM_STREAM_ATOM) str = pl_atom_tbl[Pl_Rd_Atom_Check(sink_term_word)].name; else { n = Pl_List_Length(sink_term_word); /* -1 if not a list */ if (n >= 0) str = Malloc(n + 1); /* +1 for \0 */ else str = pl_glob_buff; if (SYS_VAR_OPTION_MASK == TERM_STREAM_CHARS) Pl_Rd_Chars_Str_Check(sink_term_word, str); else Pl_Rd_Codes_Str_Check(sink_term_word, str); } stm = Pl_Add_Str_Stream(str, SYS_VAR_OPTION_MASK); Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_CLOSE_INPUT_TERM_STREAM_1 * * * *-------------------------------------------------------------------------*/ void Pl_Close_Input_Term_Stream_1(WamWord sora_word) { int stm; StmInf *pstm; StrSInf *str_stream; int type; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; type = pstm->prop.other; if (type < 1 || type > 3) Pl_Err_Domain(pl_domain_term_stream_or_alias, sora_word); if (pstm->prop.output) Pl_Err_Permission(pl_permission_operation_close, pl_permission_type_stream, sora_word); if (type != TERM_STREAM_ATOM) { str_stream = (StrSInf *) (pstm->file); Free(str_stream->buff); } Pl_Delete_Str_Stream(stm); } /*-------------------------------------------------------------------------* * PL_OPEN_OUTPUT_TERM_STREAM_1 * * * *-------------------------------------------------------------------------*/ void Pl_Open_Output_Term_Stream_1(WamWord stm_word) { int stm; stm = Pl_Add_Str_Stream(NULL, SYS_VAR_OPTION_MASK); Pl_Get_Integer(stm, stm_word); } /*-------------------------------------------------------------------------* * PL_CLOSE_OUTPUT_TERM_STREAM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Close_Output_Term_Stream_2(WamWord sora_word, WamWord sink_term_word) { int stm; StmInf *pstm; int type; char *str; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; type = pstm->prop.other; if (type < 1 || type > 3) Pl_Err_Domain(pl_domain_term_stream_or_alias, sora_word); if (pstm->prop.input) Pl_Err_Permission(pl_permission_operation_close, pl_permission_type_stream, sora_word); str = Pl_Term_Write_Str_Stream(stm); switch (SYS_VAR_OPTION_MASK) { case TERM_STREAM_ATOM: if (!Pl_Un_String_Check(str, sink_term_word)) return FALSE; break; case TERM_STREAM_CHARS: if (!Pl_Un_Chars_Check(str, sink_term_word)) return FALSE; break; case TERM_STREAM_CODES: if (!Pl_Un_Codes_Check(str, sink_term_word)) return FALSE; break; } Pl_Delete_Str_Stream(stm); return TRUE; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/atom.pl��������������������������������������������������������������������0000644�0001750�0001750�00000014025�13021324543�014576� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : atom.pl * * Descr.: atom manipulation management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_atom'. atom_length(Atom, Length) :- set_bip_name(atom_length, 2), '$call_c_test'('Pl_Atom_Length_2'(Atom, Length)). atom_concat(Atom1, Atom2, Atom3) :- set_bip_name(atom_concat, 3), '$call_c_test'('Pl_Atom_Concat_3'(Atom1, Atom2, Atom3)). '$atom_concat_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Atom_Concat_Alt_0'). sub_atom(Atom, Before, Length, After, SubAtom) :- set_bip_name(sub_atom, 5), '$call_c_test'('Pl_Sub_Atom_5'(Atom, Before, Length, After, SubAtom)). '$sub_atom_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Sub_Atom_Alt_0'). atom_chars(Atom, Chars) :- set_bip_name(atom_chars, 2), '$call_c_test'('Pl_Atom_Chars_2'(Atom, Chars)). atom_codes(Atom, Codes) :- set_bip_name(atom_codes, 2), '$call_c_test'('Pl_Atom_Codes_2'(Atom, Codes)). number_atom(Number, Atom) :- set_bip_name(number_atom, 2), '$call_c_test'('Pl_Number_Atom_2'(Number, Atom)). number_chars(Number, Chars) :- set_bip_name(number_chars, 2), '$call_c_test'('Pl_Number_Chars_2'(Number, Chars)). number_codes(Number, Codes) :- set_bip_name(number_codes, 2), '$call_c_test'('Pl_Number_Codes_2'(Number, Codes)). char_code(Char, Code) :- set_bip_name(char_code, 2), '$call_c_test'('Pl_Char_Code_2'(Char, Code)). name(Atomic, Codes) :- set_bip_name(name, 2), '$call_c_test'('Pl_Name_2'(Atomic, Codes)). lower_upper(Lower, Upper) :- set_bip_name(lower_upper, 2), '$call_c_test'('Pl_Lower_Upper_2'(Lower, Upper)). current_atom(X) :- set_bip_name(current_atom, 1), '$current_atom'(X). '$current_atom'(X) :- '$call_c_test'('Pl_Current_Atom_2'(X, 1)). '$current_atom_any'(X) :- '$call_c_test'('Pl_Current_Atom_2'(X, 0)). '$current_atom_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Current_Atom_Alt_0'). atom_property(Atom, Property) :- set_bip_name(atom_property, 2), '$current_atom'(Atom), '$atom_property1'(Atom, Property). '$atom_property_any'(Atom, Property) :- '$current_atom_any'(Atom), '$atom_property1'(Atom, Property). '$atom_property1'(Atom, Property) :- '$check_atom_prop'(Property), !, '$call_c'('Pl_Atom_Property_6'(Atom, PrefixOp, InfixOp, PostfixOp, NeedsQuotes, NeedsScan)), '$atom_property2'(Property, Atom, PrefixOp, InfixOp, PostfixOp, NeedsQuotes, NeedsScan). '$check_atom_prop'(Property) :- var(Property). '$check_atom_prop'(length(_)). '$check_atom_prop'(hash(_)). '$check_atom_prop'(prefix_op). '$check_atom_prop'(infix_op). '$check_atom_prop'(postfix_op). '$check_atom_prop'(needs_quotes). '$check_atom_prop'(needs_scan). '$check_atom_prop'(Property) :- '$pl_err_domain'(atom_property, Property). '$atom_property2'(length(Length), Atom, _, _, _, _, _) :- '$call_c_test'('Pl_Atom_Length_2'(Atom, Length)). '$atom_property2'(hash(Hash), Atom, _, _, _, _, _) :- '$call_c_test'('Pl_Term_Hash_2'(Atom, Hash)). '$atom_property2'(prefix_op, _, 1, _, _, _, _). '$atom_property2'(infix_op, _, _, 1, _, _, _). '$atom_property2'(postfix_op, _, _, _, 1, _, _). '$atom_property2'(needs_quotes, _, _, _, _, 1, _). '$atom_property2'(needs_scan, _, _, _, _, _, 1). new_atom(X) :- set_bip_name(new_atom, 1), '$call_c_test'('Pl_New_Atom_2'(atom_, X)). new_atom(Prefix, X) :- set_bip_name(new_atom, 2), '$call_c_test'('Pl_New_Atom_2'(Prefix, X)). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/flag_supp.h����������������������������������������������������������������0000644�0001750�0001750�00000023547�13021324543�015443� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : flag_supp.h * * Descr.: Prolog flag and system variable support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /* values for integer_rounding_function */ #define PF_ROUND_ZERO 0 #define PF_ROUND_DOWN 1 /* values for unknown, syntax_error, os_error */ #define PF_ERR_ERROR 0 /* same order as in read.pl */ #define PF_ERR_WARNING 1 #define PF_ERR_FAIL 2 /* values for double_quotes and back_quotes */ #define PF_QUOT_AS_CODES 0 /* bit 2 is set if no_escape */ #define PF_QUOT_AS_CHARS 1 #define PF_QUOT_AS_ATOM 2 #define PF_QUOT_NO_ESCAPE_BIT 2 #define PF_QUOT_AS_PART_MASK ((1 << PF_QUOT_NO_ESCAPE_BIT) - 1) #define PF_QUOT_NO_ESCAPE_MASK ((1 << PF_QUOT_NO_ESCAPE_BIT)) /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct flag_inf *FlagInfP; typedef WamWord (*FlagFctGet)(FlagInfP flag); typedef Bool (*FlagFctChk)(FlagInfP flag, WamWord tag_mask, WamWord value_word); typedef Bool (*FlagFctSet)(FlagInfP flag, WamWord value_word); typedef enum { PF_TYPE_INTEGER, /* an integer (value = int) */ PF_TYPE_ATOM, /* an atom (value = int of atom) */ PF_TYPE_ROUND, /* toward_zero/down (see PF_ROUND_)*/ PF_TYPE_BOOL, /* false/true */ PF_TYPE_ON_OFF, /* off/on (value = 0/1) */ PF_TYPE_ERR, /* error,warning,fail (see PF_ERR_)*/ PF_TYPE_QUOTES, /* chars,... (see PF_QUOTES_) */ PF_TYPE_ANY /* other (value = user handled) */ }FlagType; typedef struct flag_inf /* flag information */ { /* ------------------------------- */ int atom_name; /* atom of the flag name */ Bool modifiable; /* is it modifiable ? */ FlagType type; /* type see PF_TYPE_xxx */ PlLong value; /* flag value (generic value) */ FlagFctGet fct_get; /* value -> term (curr prolog flag)*/ FlagFctChk fct_chk; /* check term (for set prolog flag)*/ FlagFctSet fct_set; /* term -> value (set prolog flag)*/ }FlagInf; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ FlagInf *Pl_New_Prolog_Flag(char *name, Bool modifiable, FlagType type, PlLong value, FlagFctGet fct_get, FlagFctChk fct_chk, FlagFctSet fct_set); /* macros to create flags of predefined types. * modifiable flags give rise to global variable pl_flag_xxx */ #define NEW_FLAG_INTEGER(f, v) Pl_New_Prolog_Flag(#f, FALSE, PF_TYPE_INTEGER, v, NULL, NULL, NULL) #define NEW_FLAG_ATOM_A(f, v) Pl_New_Prolog_Flag(#f, FALSE, PF_TYPE_ATOM, v, NULL, NULL, NULL) #define NEW_FLAG_ATOM(f, v) Pl_New_Prolog_Flag(#f, FALSE, PF_TYPE_ATOM, Pl_Create_Atom(v), NULL, NULL, NULL) #define NEW_FLAG_ROUND(f, v) Pl_New_Prolog_Flag(#f, FALSE, PF_TYPE_ROUND, v, NULL, NULL, NULL) #define NEW_FLAG_BOOL(f, v) Pl_New_Prolog_Flag(#f, FALSE, PF_TYPE_BOOL, v, NULL, NULL, NULL) #define NEW_FLAG_ON_OFF(f, v) pl_flag_##f = Pl_New_Prolog_Flag(#f, TRUE, PF_TYPE_ON_OFF, v, NULL, NULL, NULL) #define NEW_FLAG_ERR(f, v) pl_flag_##f = Pl_New_Prolog_Flag(#f, TRUE, PF_TYPE_ERR, v, NULL, NULL, NULL) #define NEW_FLAG_QUOTES(f, v) pl_flag_##f = Pl_New_Prolog_Flag(#f, TRUE, PF_TYPE_QUOTES, v, NULL, NULL, NULL) #define Flag_Value(f) ((pl_flag_##f)->value) /*-------------------------------------------------------------------------* * Things related to flag_c.c: * * - concrete implementation of flags (e.g. variables pl_flag_xxx) * * - system variables management (sys_var) * * All of this should be better in another .h file but here for simplicity * *-------------------------------------------------------------------------*/ #define Char_Conversion(c) ((Flag_Value(char_conversion) && \ Is_Valid_Code(c)) ? pl_char_conv[c] : (c)) #define SYS_VAR_OPTION_MASK (pl_sys_var[0]) #define SYS_VAR_WRITE_DEPTH (pl_sys_var[1]) #define SYS_VAR_SYNTAX_ERROR_ACTON (pl_sys_var[1]) #define SYS_VAR_WRITE_PREC (pl_sys_var[2]) #define SYS_VAR_WRITE_ABOVE (pl_sys_var[3]) #define SYS_VAR_FD_BCKTS (pl_sys_var[4]) #define SYS_VAR_TOP_LEVEL (pl_sys_var[10]) #define SYS_VAR_LINEDIT (pl_sys_var[12]) #define SYS_VAR_DEBUGGER (pl_sys_var[13]) #define SYS_VAR_SAY_GETC (pl_sys_var[20]) #define CHAR_TO_EMIT_WHEN_CHAR '\1' #ifdef FLAG_C_FILE PlLong pl_sys_var[MAX_SYS_VARS]; FlagInf *pl_flag_back_quotes; FlagInf *pl_flag_char_conversion; FlagInf *pl_flag_debug; FlagInf *pl_flag_double_quotes; FlagInf *pl_flag_multifile_warning; FlagInf *pl_flag_os_error; FlagInf *pl_flag_singleton_warning; FlagInf *pl_flag_strict_iso; FlagInf *pl_flag_suspicious_warning; FlagInf *pl_flag_syntax_error; FlagInf *pl_flag_unknown; #else extern PlLong pl_sys_var[]; extern FlagInf *pl_flag_back_quotes; extern FlagInf *pl_flag_char_conversion; extern FlagInf *pl_flag_debug; extern FlagInf *pl_flag_double_quotes; extern FlagInf *pl_flag_multifile_warning; extern FlagInf *pl_flag_os_error; extern FlagInf *pl_flag_singleton_warning; extern FlagInf *pl_flag_strict_iso; extern FlagInf *pl_flag_suspicious_warning; extern FlagInf *pl_flag_syntax_error; extern FlagInf *pl_flag_unknown; #endif Bool Pl_Read_Pl_State_File(WamWord file_word); Bool Pl_Write_Pl_State_File(WamWord file_word); /*-------------------------------------------------------------------------* * System variables (C and Prolog) - bank description * * * * 0: temporary (e.g. masks for option lists (open/read/write)). * * 1: temporary (e.g. depth in write). * * 2: temporary (e.g. reorder in FD labeling). * * 3: temporary (e.g. write '$above' limit). * * 4: temporary (e.g. backtracks counter in FD labeling). * * * * 7: permanent catch handler. * * 8: permanent catch ball. * * * * 10: permanent top level depth (for top-level and stop/abort). * * 11: permanent top level handler (B level) for abort and stop. * * 12: permanent: is linedit present ? * * 13: permanent: is the debugger present ? * * * * 20: permanent: should stream fcts emit a char before calling fgetc ? * * * * 100..: free for users (who know pl_sys_var[] exists !) * *-------------------------------------------------------------------------*/ ���������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/bips_pl.h������������������������������������������������������������������0000644�0001750�0001750�00000006071�13021324543�015104� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : bips_pl.h * * Descr.: general header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "b_params.h" #include "inl_protos.h" #include "c_supp.h" #include "foreign_supp.h" #include "pred_supp.h" #include "term_supp.h" #include "stream_supp.h" #include "error_supp.h" #include "scan_supp.h" #include "parse_supp.h" #include "write_supp.h" #include "flag_supp.h" #include "dynam_supp.h" #include "callinf_supp.h" #include "bc_supp.h" �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/format.wam�����������������������������������������������������������������0000644�0001750�0001750�00000001071�13021356407�015300� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : format.pl file_name('/home/diaz/GP/src/BipsPl/format.pl'). predicate(system:'$use_format'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:format/2,46,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[format,2]), call_c('Pl_Format_2',[],[x(0),x(1)]), proceed]). predicate(system:format/3,53,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[format,3]), call_c('Pl_Format_3',[],[x(0),x(1),x(2)]), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/debugger_c.c���������������������������������������������������������������0000644�0001750�0001750�00000100645�13021324543�015537� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : debugger_c.c * * Descr.: debugger - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #include <stdlib.h> #include <setjmp.h> #if defined(_WIN32) || defined(__CYGWIN__) #include <windows.h> #endif #define OBJ_INIT Debug_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define BANK_NAME_OFFSET_LENGTH 15 #if WORD_SIZE == 32 #define HEXADECIMAL_LENGTH 10 #define DECIMAL_LENGTH 11 #else #define HEXADECIMAL_LENGTH 20 #define DECIMAL_LENGTH 21 #endif #define VALUE_PART_LENGTH BANK_NAME_OFFSET_LENGTH #define SEPARATOR_LIST " ,[]\n" /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef Bool (*FctPtr) (); typedef struct { char *name; FctPtr fct; } InfCmd; /*---------------------------------* * Global Variables * *---------------------------------*/ WamCont pl_debug_call_code; static int nb_read_arg; static char read_arg[30][80]; static char *envir_name[] = ENVIR_NAMES; static char *choice_name[] = CHOICE_NAMES; static char *trail_tag_name[] = TRAIL_TAG_NAMES; static WamWord reg_copy[NB_OF_REGS]; static StmInf *pstm_i; static StmInf *pstm_o; static sigjmp_buf dbg_jumper; static void *invalid_addr; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void My_System_Directives(void); static void Scan_Command(char *source_str); static FctPtr Find_Function(void); static Bool Write_Data_Modify(void); static Bool Where(void); static Bool What(void); static Bool Dereference(void); static Bool Environment(void); static Bool Backtrack(void); static WamWord *Read_Bank_Adr(Bool only_stack, int arg_nb, char **bank_name); static PlLong Read_An_Integer(int arg_nb); static void Print_Bank_Name_Offset(char *prefix, char *bank_name, int offset); static void Print_Wam_Word(WamWord *word_adr); static void Modify_Wam_Word(WamWord *word_adr); static WamWord *Detect_Stack(WamWord *adr, char **stack_name); static PredInf *Detect_Pred_From_Code(CodePtr codep); static Bool Help(void); #define INIT_DEBUGGER X1_24696E69745F6465627567676572 #define DEBUG_CALL X1_2464656275675F63616C6C Prolog_Prototype(INIT_DEBUGGER, 0); Prolog_Prototype(DEBUG_CALL, 3); /*-------------------------------------------------------------------------* * DEBUG_INITIALIZER * * * * Calls '$init_debugger' and reset the heap actual start (cf. engine.c). * * '$init_debugger' is not called via a directive :- initialize to avoid to* * count it in Exec_Directive() (cf engine.c). However, it cannot be called* * directly since we do not know if the initializer of g_var_inl_c.c has * * been executed ('$init_debugger' uses g_assign). * * We thus act like a Prolog object, calling New_Object. * *-------------------------------------------------------------------------*/ static void Debug_Initializer(void) { Pl_New_Object(NULL, My_System_Directives, NULL); } static void My_System_Directives(void) { Pl_Call_Prolog(Prolog_Predicate(INIT_DEBUGGER, 0)); Pl_Set_Heap_Actual_Start(H); /* changed to store global info */ } /*-------------------------------------------------------------------------* * PL_SET_DEBUG_CALL_CODE_0 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Debug_Call_Code_0(void) { pl_debug_call_code = Prolog_Predicate(DEBUG_CALL, 3); Flag_Value(debug) = TRUE; } /*-------------------------------------------------------------------------* * PL_RESET_DEBUG_CALL_CODE_0 * * * *-------------------------------------------------------------------------*/ void Pl_Reset_Debug_Call_Code_0(void) { pl_debug_call_code = NULL; Flag_Value(debug) = FALSE; } /*-------------------------------------------------------------------------* * PL_REMOVE_ONE_CHOICE_POINT_1 * * * *-------------------------------------------------------------------------*/ void Pl_Remove_One_Choice_Point_1(WamWord b_word) { WamWord word, tag_mask; WamWord *b; DEREF(b_word, word, tag_mask); b = From_WamWord_To_B(word); Assign_B(BB(b)); } /*-------------------------------------------------------------------------* * PL_CHOICE_POINT_INFO_5 * * * *-------------------------------------------------------------------------*/ void Pl_Choice_Point_Info_5(WamWord b_word, WamWord module_word, WamWord func_word, WamWord arity_word, WamWord lastb_word) { WamWord word, tag_mask; WamWord *b; PredInf *pred; DEREF(b_word, word, tag_mask); b = From_WamWord_To_B(word); pred = Detect_Pred_From_Code(ALTB(b)); if (pred != NULL) /* should not occur in practice */ { Pl_Get_Atom(pred->mod->module, module_word); Pl_Get_Atom(Functor_Of(pred->f_n), func_word); Pl_Get_Integer(Arity_Of(pred->f_n), arity_word); } Pl_Unify(From_B_To_WamWord(BB(b)), lastb_word); } /*-------------------------------------------------------------------------* * PL_SCAN_CHOICE_POINT_INFO_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Scan_Choice_Point_Info_4(WamWord b_word, WamWord module_word, WamWord func_word, WamWord arity_word) { WamWord word, tag_mask; WamWord *b; int module, func, arity; DEREF(b_word, word, tag_mask); b = From_WamWord_To_B(word); module = Pl_Scan_Choice_Point_Pred(b, &func, &arity); if (module < 0) return FALSE; Pl_Get_Atom(module, module_word); Pl_Get_Atom(func, func_word); Pl_Get_Integer(arity, arity_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_CHOICE_POINT_ARG_3 * * * *-------------------------------------------------------------------------*/ void Pl_Choice_Point_Arg_3(WamWord b_word, WamWord i_word, WamWord arg_word) { WamWord word, tag_mask; WamWord *b; PlLong i; DEREF(b_word, word, tag_mask); b = From_WamWord_To_B(word); DEREF(i_word, word, tag_mask); i = UnTag_INT(word) - 1; Pl_Unify(arg_word, AB(b, i)); } /*-------------------------------------------------------------------------* * DEBUGGER_SIGSEGV_HANDLER * * * *-------------------------------------------------------------------------*/ static int Debugger_SIGSEGV_Handler(void *bad_addr) { invalid_addr = bad_addr; siglongjmp(dbg_jumper, 1); return 1; } /*-------------------------------------------------------------------------* * PL_DEBUG_WAM * * * *-------------------------------------------------------------------------*/ void Pl_Debug_Wam(void) { FctPtr command; char str[80] = ""; char *prompt = "(wam debug) "; int ret; pstm_i = pl_stm_tbl[pl_stm_debugger_input]; pstm_o = pl_stm_tbl[pl_stm_debugger_output]; Pl_Stream_Printf(pstm_o, "Welcome to the WAM debugger - experts only\n"); Pl_Push_SIGSEGV_Handler(Debugger_SIGSEGV_Handler); restart: ret = sigsetjmp(dbg_jumper, 1); if (ret != 0) { Pl_Stream_Printf(pstm_o, "SIGSEGV occured at: %p\n", invalid_addr); goto restart; } for (;;) { if (Pl_Stream_Gets_Prompt(prompt, pstm_o, str, sizeof(str), pstm_i) == NULL) break; Scan_Command(str); command = Find_Function(); if (command == (FctPtr) -1) break; if (command) (*command) (); } Pl_Pop_SIGSEGV_Handler(); } /*-------------------------------------------------------------------------* * SCAN_COMMAND * * * *-------------------------------------------------------------------------*/ static void Scan_Command(char *source_str) { char str[80]; char *p, *q; strcpy(str, source_str); nb_read_arg = 0; p = (char *) strtok(str, SEPARATOR_LIST); while (p) { q = p; p = (char *) strtok(NULL, SEPARATOR_LIST); strcpy(read_arg[nb_read_arg++], q); } } /*-------------------------------------------------------------------------* * FIND_FUNCTION * * * *-------------------------------------------------------------------------*/ static FctPtr Find_Function(void) { int lg; int i; static InfCmd cmd[] = { {"write", Write_Data_Modify}, {"data", Write_Data_Modify}, {"modify", Write_Data_Modify}, {"where", Where}, {"what", What}, {"deref", Dereference}, {"envir", Environment}, {"backtrack", Backtrack}, {"quit", (FctPtr) -1}, {"help", Help} }; if (nb_read_arg == 0) return NULL; lg = strlen(read_arg[0]); for (i = 0; i < sizeof(cmd) / sizeof(InfCmd); i++) if (strncmp(cmd[i].name, read_arg[0], lg) == 0) return cmd[i].fct; Pl_Stream_Printf(pstm_o, "Unknown command - try help\n"); return NULL; } /*-------------------------------------------------------------------------* * WRITE_DATA_MODIFY * * * *-------------------------------------------------------------------------*/ static Bool Write_Data_Modify(void) { WamWord *adr; char *bank_name; int offset; int nb; int incr = 1; if ((adr = Read_Bank_Adr(FALSE, 1, &bank_name)) != NULL) { offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); nb = (nb_read_arg < 4) ? 1 : Read_An_Integer(3); if (adr == reg_copy) { if (offset >= NB_OF_REGS) offset = 0; if (nb_read_arg < 4 && *read_arg[0] != 'm') nb = NB_OF_REGS - offset; else if (nb > NB_OF_REGS - offset) nb = NB_OF_REGS - offset; } else if (strcmp(bank_name, "y") == 0 || strcmp(bank_name, "ab") == 0) incr = -1; while (nb--) { Print_Bank_Name_Offset((adr == reg_copy) ? pl_reg_tbl[offset] : "", bank_name, offset); Pl_Stream_Printf(pstm_o, ":"); if (*read_arg[0] == 'w') Pl_Write_Term(pstm_o, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS, NULL, adr[offset]); else { Print_Wam_Word(adr + offset); if (*read_arg[0] == 'm') Modify_Wam_Word(adr + offset); } Pl_Stream_Printf(pstm_o, "\n"); offset += incr; } } if (adr == reg_copy) /* saved by Read_Bank_Adr */ Restore_All_Regs(reg_copy); return FALSE; } /*-------------------------------------------------------------------------* * WHAT * * * *-------------------------------------------------------------------------*/ static Bool What(void) { PlLong *adr; WamWord *adr1; char *stack_name; PredInf *pred; int func, arity; if (nb_read_arg < 2) { Pl_Stream_Printf(pstm_o, "integer expected\n"); return FALSE; } adr = (PlLong *) Read_An_Integer(1); Pl_Stream_Printf(pstm_o, " %#" PL_FMT_x " = ", (PlLong) adr); if ((adr1 = Detect_Stack(adr, &stack_name)) != NULL) { Print_Bank_Name_Offset("", stack_name, adr - adr1); Pl_Stream_Printf(pstm_o, "\n"); return FALSE; } if ((pred = Detect_Pred_From_Code((CodePtr) adr)) != NULL) { func = Functor_Of(pred->f_n); arity = Arity_Of(pred->f_n); Pl_Stream_Printf(pstm_o, "%s/%d", pl_atom_tbl[func].name, arity); if (adr > (PlLong *) (pred->codep)) Pl_Stream_Printf(pstm_o, "+%d", (char *) adr - (char *) (pred->codep)); Pl_Stream_Printf(pstm_o, "\n"); return FALSE; } Pl_Stream_Printf(pstm_o, "???\n"); return FALSE; } /*-------------------------------------------------------------------------* * WHERE * * * *-------------------------------------------------------------------------*/ static Bool Where(void) { char *bank_name; int offset; WamWord *adr; if ((adr = Read_Bank_Adr(FALSE, 1, &bank_name)) != NULL) { offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); if (strcmp(bank_name, "y") == 0 || strcmp(bank_name, "ab") == 0) offset = -offset; Print_Bank_Name_Offset((adr == reg_copy) ? pl_reg_tbl[offset] : "", bank_name, offset); Pl_Stream_Printf(pstm_o, " at %#" PL_FMT_x "\n", (PlLong) (adr + offset)); } return FALSE; } /*-------------------------------------------------------------------------* * DEREFERENCE * * * *-------------------------------------------------------------------------*/ static Bool Dereference(void) { char *bank_name; char *stack_name; int offset; WamWord word, tag_mask; WamWord word1, *d_adr; WamWord *adr; if ((adr = Read_Bank_Adr(FALSE, 1, &bank_name)) != NULL) { offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); if (strcmp(bank_name, "y") == 0 || strcmp(bank_name, "ab") == 0) offset = -offset; /* my own DEREF here to get the address */ d_adr = NULL; /* added this */ word = adr[offset]; do { word1 = word; tag_mask = Tag_Mask_Of(word); if (tag_mask != TAG_REF_MASK) break; d_adr = UnTag_REF(word); /* added this */ word = *d_adr; } while (word != word1); Print_Bank_Name_Offset((adr == reg_copy) ? pl_reg_tbl[offset] : "", bank_name, offset); Pl_Stream_Printf(pstm_o, ":"); if (d_adr && (adr = Detect_Stack(d_adr, &stack_name)) != NULL) { Pl_Stream_Printf(pstm_o, " --> \n"); Print_Bank_Name_Offset("", stack_name, d_adr - adr); Pl_Stream_Printf(pstm_o, ":"); } Print_Wam_Word(d_adr ? d_adr : adr + offset); Pl_Stream_Printf(pstm_o, "\n"); } return FALSE; } /*-------------------------------------------------------------------------* * ENVIRONMENT * * * *-------------------------------------------------------------------------*/ static Bool Environment(void) { WamWord *adr; int offset; char *stack_name; int i; if (nb_read_arg == 1) { adr = Detect_Stack(E, &stack_name); offset = E - adr; adr = E; } else { if ((adr = Read_Bank_Adr(TRUE, 1, &stack_name)) == NULL) return FALSE; offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); adr += offset; } for (i = ENVIR_STATIC_SIZE; i > 0; i--) { Print_Bank_Name_Offset(envir_name[i - 1], stack_name, offset - i); Pl_Stream_Printf(pstm_o, ":"); Print_Wam_Word(adr - i); Pl_Stream_Printf(pstm_o, "\n"); } return FALSE; } /*-------------------------------------------------------------------------* * BACKTRACK * * * *-------------------------------------------------------------------------*/ static Bool Backtrack(void) { WamWord *adr; int offset; char *stack_name; int i; PredInf *pred; int func, arity; if (nb_read_arg == 2 && strncmp(read_arg[1], "all", strlen(read_arg[1])) == 0) { Detect_Stack(B, &stack_name); for (adr = B; adr > Local_Stack + 10; adr = BB(adr)) { pred = Detect_Pred_From_Code(ALTB(adr)); func = Functor_Of(pred->f_n); arity = Arity_Of(pred->f_n); Print_Bank_Name_Offset("", stack_name, adr - Local_Stack); Pl_Stream_Printf(pstm_o, ": %s/%d", pl_atom_tbl[func].name, arity); if (arity == 0 && strcmp(pl_atom_tbl[func].name, "$clause_alt") == 0) { Pl_Stream_Printf(pstm_o, " for "); Pl_Write_Term(pstm_o, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS, NULL, AB(adr, 0)); } Pl_Stream_Printf(pstm_o, "\n"); } return FALSE; } if (nb_read_arg == 1) { adr = Detect_Stack(B, &stack_name); offset = B - adr; adr = B; } else { if ((adr = Read_Bank_Adr(TRUE, 1, &stack_name)) == NULL) return FALSE; offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); adr += offset; } pred = Detect_Pred_From_Code(ALTB(adr)); func = Functor_Of(pred->f_n); arity = Arity_Of(pred->f_n); Pl_Stream_Printf(pstm_o, "Created by %s/%d", pl_atom_tbl[func].name, arity); if (arity == 0 && strcmp(pl_atom_tbl[func].name, "$clause_alt") == 0) { Pl_Stream_Printf(pstm_o, " for "); Pl_Write_Term(pstm_o, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS, NULL, AB(adr, 0)); } Pl_Stream_Printf(pstm_o, "\n"); for (i = CHOICE_STATIC_SIZE; i > 0; i--) { Print_Bank_Name_Offset(choice_name[i - 1], stack_name, offset - i); Pl_Stream_Printf(pstm_o, ":"); Print_Wam_Word(adr - i); Pl_Stream_Printf(pstm_o, "\n"); } return FALSE; } /*-------------------------------------------------------------------------* * READ_BANK_ADR * * * *-------------------------------------------------------------------------*/ static WamWord * Read_Bank_Adr(Bool only_stack, int arg_nb, char **bank_name) { int lg; int i; if (nb_read_arg < arg_nb + 1) { Pl_Stream_Printf(pstm_o, "%s name expected\n", (only_stack) ? "Stack" : "Bank"); return NULL; } lg = strlen(read_arg[arg_nb]); if (!only_stack) { if (read_arg[arg_nb][0] == 'x' && lg == 1) { *bank_name = "x"; return &X(0); } if (read_arg[arg_nb][0] == 'y' && lg == 1) { *bank_name = "y"; return &Y(E, 0); } if (strncmp("ab", read_arg[arg_nb], lg) == 0) { *bank_name = "ab"; return &AB(B, 0); } if (strncmp("reg", read_arg[arg_nb], lg) == 0) { *bank_name = "reg"; Save_All_Regs(reg_copy); return reg_copy; } } for (i = 0; i < NB_OF_STACKS; i++) if (strncmp(pl_stk_tbl[i].name, read_arg[arg_nb], lg) == 0) { *bank_name = pl_stk_tbl[i].name; return pl_stk_tbl[i].stack; } Pl_Stream_Printf(pstm_o, "Incorrect %s name\n", (only_stack) ? "stack" : "bank"); return NULL; } /*-------------------------------------------------------------------------* * READ_AN_INTEGER * * * *-------------------------------------------------------------------------*/ static PlLong Read_An_Integer(int arg_nb) { char *p; PlLong val = 0; val = Str_To_PlLong(read_arg[arg_nb], &p, 0); if (*p) Pl_Stream_Printf(pstm_o, "Incorrect integer\n"); return val; } /*-------------------------------------------------------------------------* * PRINT_BANK_NAME_OFFSET * * * *-------------------------------------------------------------------------*/ static void Print_Bank_Name_Offset(char *prefix, char *bank_name, int offset) { char str[80]; int lg = strlen(prefix); if (lg) Pl_Stream_Printf(pstm_o, "%s", prefix); sprintf(str, "%s[%d]", bank_name, offset); lg += strlen(str); if (lg > BANK_NAME_OFFSET_LENGTH) lg = BANK_NAME_OFFSET_LENGTH; Pl_Stream_Printf(pstm_o, "%*s%s", BANK_NAME_OFFSET_LENGTH - lg, "", str); } /*-------------------------------------------------------------------------* * PRINT_WAM_WORD * * * *-------------------------------------------------------------------------*/ static void Print_Wam_Word(WamWord *word_adr) { WamWord word = *word_adr; WamWord tag; WamWord value; char *stack_name; WamWord *adr; int functor; int arity; int i; Pl_Stream_Printf(pstm_o, "%#*" PL_FMT_x " %*" PL_FMT_d " ", HEXADECIMAL_LENGTH, (PlLong) word, DECIMAL_LENGTH, (PlLong) word); if ((adr = Detect_Stack((WamWord *) word, &stack_name)) != NULL) Print_Bank_Name_Offset("", stack_name, (WamWord *) word - adr); else Pl_Stream_Printf(pstm_o, "%*s", BANK_NAME_OFFSET_LENGTH, "?[?]"); Pl_Stream_Printf(pstm_o, " "); tag = Tag_Of(word); for (i = 0; i < NB_OF_TAGS; i++) if (pl_tag_tbl[i].value == tag) break; if (i < NB_OF_TAGS) switch (pl_tag_tbl[i].type) { case LONG_INT: value = (WamWord) UnTag_Long_Int(word); Pl_Stream_Printf(pstm_o, "%s,%*" PL_FMT_d, pl_tag_tbl[i].name, VALUE_PART_LENGTH, (PlLong) value); break; case SHORT_UNS: value = (WamWord) UnTag_Short_Uns(word); if (tag == ATM && value >= 0 && value < pl_max_atom && pl_atom_tbl[value].name != NULL) Pl_Stream_Printf(pstm_o, "ATM,%*s (%" PL_FMT_d, VALUE_PART_LENGTH, pl_atom_tbl[value].name, (PlLong) value); else if (tag == ATM) tag = -1; else Pl_Stream_Printf(pstm_o, "%s,%*" PL_FMT_u, pl_tag_tbl[i].name, VALUE_PART_LENGTH, (PlLong) value); break; case ADDRESS: value = (WamWord) UnTag_Address(word); if ((adr = Detect_Stack((WamWord *) value, &stack_name)) != NULL) { Pl_Stream_Printf(pstm_o, "%s,", pl_tag_tbl[i].name); Print_Bank_Name_Offset("", stack_name, (WamWord *) value - adr); } else tag = -1; break; } else tag = -1; if (tag == -1) Pl_Stream_Printf(pstm_o, "???,%*s", VALUE_PART_LENGTH, "?"); Pl_Stream_Printf(pstm_o, " "); if (word_adr >= Trail_Stack && word_adr < Trail_Stack + Trail_Size) { tag = Trail_Tag_Of(word); value = Trail_Value_Of(word); if (tag == TFC) Pl_Stream_Printf(pstm_o, "%s,%#*" PL_FMT_x, trail_tag_name[tag], VALUE_PART_LENGTH, (PlLong) value); else if (tag < NB_OF_TRAIL_TAGS && (adr = Detect_Stack((WamWord *) value, &stack_name)) != NULL && *stack_name != 't') { Pl_Stream_Printf(pstm_o, "%s,", trail_tag_name[tag]); Print_Bank_Name_Offset("", stack_name, (WamWord *) value - adr); } else Pl_Stream_Printf(pstm_o, "???,%*s", VALUE_PART_LENGTH, "?"); Pl_Stream_Printf(pstm_o, " "); } functor = Functor_Of(word); arity = Arity_Of(word); if (functor >= 0 && functor < pl_max_atom && pl_atom_tbl[functor].name != NULL && arity >= 0 && arity <= MAX_ARITY) Pl_Stream_Printf(pstm_o, "%12s/%-3d", pl_atom_tbl[functor].name, arity); } /*-------------------------------------------------------------------------* * MODIFY_WAM_WORD * * * *-------------------------------------------------------------------------*/ static void Modify_Wam_Word(WamWord *word_adr) { WamWord word; char *bank_name; WamWord *adr; int offset; char str[80]; char *comma; char *slash; char *p; int i, j; for (;;) { Pl_Stream_Printf(pstm_o, "\n"); if (Pl_Stream_Gets_Prompt("New value: ", pstm_o, str, sizeof(str), pstm_i) == NULL || *str == '\0' || *str == '\n') break; Scan_Command(str); if ((comma = (char *) strchr(str, ',')) != NULL) goto tag_value; if ((slash = (char *) strchr(read_arg[0], '/')) != NULL) goto functor_arity; /* integer */ if (nb_read_arg == 1 && *read_arg[0] >= '0' && *read_arg[0] <= '9') { word = Str_To_PlLong(read_arg[0], &p, 0); if (*p == '\0') { *word_adr = word; return; } else goto err; } /* stack address */ if ((adr = Read_Bank_Adr(TRUE, 0, &bank_name)) != NULL) { offset = (nb_read_arg < 2) ? 0 : Read_An_Integer(1); *word_adr = (WamWord) (adr + offset); return; } goto err; /* tag,value */ tag_value: for (i = 0; i < NB_OF_TAGS; i++) if (strcmp(pl_tag_tbl[i].name, read_arg[0]) == 0) break; if (i < NB_OF_TAGS) { switch (pl_tag_tbl[i].type) { case LONG_INT: word = Str_To_PlLong(read_arg[1], &p, 0); if (*p != '\0') goto err; *word_adr = Tag_Long_Int(pl_tag_tbl[i].tag_mask, Read_An_Integer(1)); return; case SHORT_UNS: word = Str_To_PlLong(read_arg[1], &p, 0); if (*p == '\0') j = Read_An_Integer(1); else if (strcmp(read_arg[0], "ATM") == 0) j = Pl_Create_Allocate_Atom(comma + 1); else goto err; *word_adr = Tag_Short_Uns(pl_tag_tbl[i].tag_mask, j); return; case ADDRESS: if ((adr = Read_Bank_Adr(TRUE, 1, &bank_name)) != NULL) { offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); *word_adr = Tag_Address(pl_tag_tbl[i].tag_mask, adr + offset); return; } goto err; } } /* trail_tag,value */ for (i = 0; i < NB_OF_TRAIL_TAGS; i++) if (strcmp(trail_tag_name[i], read_arg[0]) == 0) if ((adr = Read_Bank_Adr(TRUE, 1, &bank_name)) != NULL) { offset = (nb_read_arg < 3) ? 0 : Read_An_Integer(2); *word_adr = Trail_Tag_Value(i, adr + offset); return; } goto err; /* functor/arity */ functor_arity: *slash = '\0'; i = strtol(slash + 1, &p, 0); if (*p != '\0' || i < 1 || i > MAX_ARITY) goto err; word = Str_To_PlLong(read_arg[0], &p, 0); if (*p != '\0') word = (PlLong) Pl_Create_Allocate_Atom(read_arg[0]); else if (word < 0 || word >= pl_max_atom) goto err; *word_adr = Functor_Arity(word, i); Pl_Stream_Printf(pstm_o, "--> %s/%d", pl_atom_tbl[word].name, i); return; err: Pl_Stream_Printf(pstm_o, "Error..."); } } /*-------------------------------------------------------------------------* * DETECT_STACK * * * *-------------------------------------------------------------------------*/ static WamWord * Detect_Stack(WamWord *adr, char **stack_name) { int i; for (i = 0; i < NB_OF_STACKS; i++) if (adr >= pl_stk_tbl[i].stack && adr < pl_stk_tbl[i].stack + pl_stk_tbl[i].size) { *stack_name = pl_stk_tbl[i].name; return pl_stk_tbl[i].stack; } return NULL; } /*-------------------------------------------------------------------------* * DETECT_PRED_FROM_CODE * * * *-------------------------------------------------------------------------*/ static PredInf * Detect_Pred_From_Code(CodePtr codep) { ModuleInf *mod; HashScan scan_mod, scan; PredInf *pred; CodePtr cur_codep, last_codep = 0; PredInf *last_pred = NULL; for(mod = (ModuleInf *) Pl_Hash_First(pl_module_tbl, &scan_mod); mod; mod = (ModuleInf *) Pl_Hash_Next(&scan_mod)) { for (pred = (PredInf *) Pl_Hash_First(mod->pred_tbl, &scan); pred; pred = (PredInf *) Pl_Hash_Next(&scan)) { cur_codep = (pred->codep); if (last_codep <= cur_codep && cur_codep <= codep) { /* cur_codep between last_codep and codep */ last_pred = pred; last_codep = cur_codep; } } } return last_pred; } /*-------------------------------------------------------------------------* * HELP * * * *-------------------------------------------------------------------------*/ static Bool Help(void) { int i; #define L(str) Pl_Stream_Printf(pstm_o, "%s\n", str) L("Wam debugging options:"); L(""); L(" write A [N] write N (or 1) Prolog terms starting at A"); L(" data A [N] display N (or 1) words starting at A"); L(" modify A [N] display and modify N (or 1) words starting at A"); L(" where A display the real address corresponding to SA"); L(" what RA display what corresponds to the real address RA"); L(" deref A display the dereferenced word starting at A"); L(" envir [SA] display an environment located at SA (or current)"); L(" backtrack [SA] display a choice point located at SA (or current)"); L(" backtrack all display all choice points"); L(" quit return to Prolog debugger"); L(""); L("A WAM address (A) has the following syntax: bank_name [N]"); L(" bank_name is either reg/x/y/ab/stack_name (see below)"); L(" N is an optional index (default 0)"); Pl_Stream_Printf(pstm_o, " stack_name is either:"); for (i = 0; i < NB_OF_STACKS; i++) Pl_Stream_Printf(pstm_o, " %s", pl_stk_tbl[i].name); Pl_Stream_Printf(pstm_o, "\n"); L(""); L("A WAM stack address (SA) has the following syntax: stack_name [N]"); L(""); L("A real address (RA) is a C integer (0x... notation is allowed)"); return FALSE; } �������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/throw.pl�������������������������������������������������������������������0000644�0001750�0001750�00000007402�13021324543�015002� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : throw.pl * * Descr.: exception management (throw) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_throw'. /* '$throw'(Ball, CallerModule, CallerFunc, CallerArity) :- format(' throw(~w,~w,~w,~w)~n',[Ball, CallerModule, CallerFunc, CallerArity]), fail. */ '$throw'(Ball, _, _, _) :- nonvar(Ball), !, '$sys_var_put'(8, Ball), '$unwind'(Ball). '$throw'(_Ball, _CallerModule, CallerFunc, CallerArity) :- % '$call_c'('Pl_Set_Error_MFA'(CallerModule, CallerFunc, CallerArity)), % FIXME '$call_c'('Pl_Set_Bip_Name_2'(CallerFunc, CallerArity)), '$pl_err_instantiation'. '$unwind'(Ball) :- '$sys_var_read'(7, Handler), '$call_c'('Pl_Throw_2'(Ball, Handler)), % mainly does a cut fail. % FIXME remove this when MFA is correctly handled everywhere (in call/catch) '$throw_internal'(Ball, CallerModule, CallInfo) :- %NB not really CallerModule but Module (see call.pl comment) '$call_c'('Pl_Call_Info_Bip_Name_1'(CallInfo)), '$call_c'('Pl_Get_Bip_Name_2'(CallerFunc, CallerArity)), %format('In throw(~w,~w,~w,~w)~n',[Ball, CallerModule, CallerFunc, CallerArity]), '$throw'(Ball, CallerModule, CallerFunc, CallerArity). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/foreign.pl�����������������������������������������������������������������0000644�0001750�0001750�00000006131�13021324543�015266� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : foreign.pl * * Descr.: foreign interface * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. % $force_foreign_link is used by pl2wam to force the link of % foreign.o and then foreign_supp.o needed by Ma2Asm for translations % using foreign_long[] and foreign_double[] indirectly via registers '$force_foreign_link'. '$pl_query_recover_alt' :- % used by C code to create a choice-point '$call_c'('Pl_Query_Recover_Alt_0'), fail. ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/term_inl_c.c���������������������������������������������������������������0000644�0001750�0001750�00000051173�13021324543�015565� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : term_inl_c.c * * Descr.: term (inline) management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static PlLong *var_ptr; static PlLong *base_var_ptr; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Collect_Variable(WamWord *adr); static Bool Check_Variable(WamWord *adr, WamWord var_word); /* Term comparison inlines */ /*-------------------------------------------------------------------------* * PL_BLT_TERM_EQ * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Term_Eq(WamWord x, WamWord y) { return Pl_Term_Compare(x, y) == 0; } /*-------------------------------------------------------------------------* * PL_BLT_TERM_NEQ * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Term_Neq(WamWord x, WamWord y) { return Pl_Term_Compare(x, y) != 0; } /*-------------------------------------------------------------------------* * PL_BLT_TERM_LT * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Term_Lt(WamWord x, WamWord y) { return Pl_Term_Compare(x, y) < 0; } /*-------------------------------------------------------------------------* * PL_BLT_TERM_LTE * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Term_Lte(WamWord x, WamWord y) { return Pl_Term_Compare(x, y) <= 0; } /*-------------------------------------------------------------------------* * PL_BLT_TERM_GT * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Term_Gt(WamWord x, WamWord y) { return Pl_Term_Compare(x, y) > 0; } /*-------------------------------------------------------------------------* * PL_BLT_TERM_GTE * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Term_Gte(WamWord x, WamWord y) { return Pl_Term_Compare(x, y) >= 0; } /*-------------------------------------------------------------------------* * PL_BLT_COMPARE * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Compare(WamWord cmp_word, WamWord x, WamWord y) { int cmp; char c; Bool res; Pl_Set_C_Bip_Name("compare", 3); cmp = Pl_Term_Compare(x, y); c = (cmp < 0) ? '<' : (cmp == 0) ? '=' : '>'; res = Pl_Un_Atom_Check(ATOM_CHAR(c), cmp_word); if (!res) /* check if it is one of < = > */ { WamWord word, tag_mask; char *s; DEREF(cmp_word, word, tag_mask); /* we know it is an atom */ s = pl_atom_tbl[UnTag_ATM(word)].name; if ((s[0] != '<' && s[0] != '=' && s[0] != '>') || s[1] != '\0') Pl_Err_Domain(pl_domain_order, cmp_word); } Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_ARG * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Arg(WamWord arg_no_word, WamWord term_word, WamWord sub_term_word) { WamWord *arg_adr; int func, arity; int arg_no; Pl_Set_C_Bip_Name("arg", 3); arg_no = Pl_Rd_Positive_Check(arg_no_word) - 1; arg_adr = Pl_Rd_Compound_Check(term_word, &func, &arity); Pl_Unset_C_Bip_Name(); return (unsigned) arg_no < (unsigned) arity && Pl_Unify(sub_term_word, arg_adr[arg_no]); } /*-------------------------------------------------------------------------* * PL_BLT_FUNCTOR * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Functor(WamWord term_word, WamWord functor_word, WamWord arity_word) { WamWord word, tag_mask; WamWord *adr; WamWord tag_functor; int arity; Bool res; Pl_Set_C_Bip_Name("functor", 3); DEREF(term_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { if (tag_mask == TAG_LST_MASK) res = Pl_Un_Atom_Check(ATOM_CHAR('.'), functor_word) && Pl_Un_Integer_Check(2, arity_word); else if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); res = Pl_Un_Atom_Check(Functor(adr), functor_word) && Pl_Un_Integer_Check(Arity(adr), arity_word); } else res = Pl_Unify(word, functor_word) && Pl_Un_Integer_Check(0, arity_word); goto finish; } /* tag_mask == TAG_REF_MASK */ DEREF(functor_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK && tag_mask != TAG_FLT_MASK) Pl_Err_Type(pl_type_atomic, functor_word); tag_functor = tag_mask; functor_word = word; arity = Pl_Rd_Positive_Check(arity_word); if (arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); if (tag_functor == TAG_ATM_MASK && UnTag_ATM(functor_word) == ATOM_CHAR('.') && arity == 2) { res = (Pl_Get_List(term_word)) ? Pl_Unify_Void(2), TRUE : FALSE; goto finish; } if (tag_functor == TAG_ATM_MASK && arity > 0) { res = (Pl_Get_Structure(UnTag_ATM(functor_word), arity, term_word)) ? Pl_Unify_Void(arity), TRUE : FALSE; goto finish; } if (arity != 0) Pl_Err_Type(pl_type_atom, functor_word); res = Pl_Unify(functor_word, term_word); finish: Pl_Unset_C_Bip_Name(); return res; } /*-------------------------------------------------------------------------* * PL_BLT_UNIV * * * *-------------------------------------------------------------------------*/ Bool FC Pl_Blt_Univ(WamWord term_word, WamWord list_word) { WamWord word, tag_mask; WamWord *adr; WamWord car_word; int lst_length; WamWord *arg1_adr; WamWord *term_adr, *lst_adr, *stc_adr; WamWord functor_word, functor_tag; int functor; int arity; Pl_Set_C_Bip_Name("=..", 2); DEREF(term_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) goto list_to_term; /* from term to list functor+args */ if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); car_word = Tag_ATM(ATOM_CHAR('.')); lst_length = 1 + 2; arg1_adr = &Car(adr); } else if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); car_word = Tag_ATM(Functor(adr)); lst_length = 1 + Arity(adr); arg1_adr = &Arg(adr, 0); } #ifndef NO_USE_FD_SOLVER else if (tag_mask == TAG_FDV_MASK) { adr = UnTag_FDV(word); car_word = Tag_REF(adr); /* since Dont_Separate_Tag */ lst_length = 1 + 0; } #endif else /* TAG_ATM/INT/FLT_MASK */ { car_word = word; lst_length = 1 + 0; } Pl_Check_For_Un_List(list_word); Pl_Unset_C_Bip_Name(); for (;;) { if (!Pl_Get_List(list_word) || !Pl_Unify_Value(car_word)) return FALSE; list_word = Pl_Unify_Variable(); if (--lst_length == 0) break; car_word = *arg1_adr++; } return Pl_Get_Nil(list_word); /* from list functor+args to term */ list_to_term: term_adr = UnTag_REF(word); DEREF(list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) Pl_Err_Domain(pl_domain_non_empty_list, list_word); if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), functor_word, functor_tag); if (functor_tag == TAG_REF_MASK) Pl_Err_Instantiation(); DEREF(Cdr(lst_adr), word, tag_mask); if (word == NIL_WORD) { if (functor_tag != TAG_ATM_MASK && functor_tag != TAG_INT_MASK && functor_tag != TAG_FLT_MASK) Pl_Err_Type(pl_type_atomic, functor_word); term_word = functor_word; goto finish; } if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (functor_tag != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, functor_word); if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, list_word); functor = UnTag_ATM(functor_word); stc_adr = H; H++; /* space for f/n maybe lost if a list */ arity = 0; for (;;) { arity++; lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); Do_Copy_Of_Word(tag_mask, word); /* since Dont_Separate_Tag */ Global_Push(word); DEREF(Cdr(lst_adr), word, tag_mask); if (word == NIL_WORD) break; if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, list_word); } if (arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); if (functor == ATOM_CHAR('.') && arity == 2) /* a list */ term_word = Tag_LST(stc_adr + 1); else { *stc_adr = Functor_Arity(functor, arity); term_word = Tag_STC(stc_adr); } finish: Bind_UV(term_adr, term_word); Pl_Unset_C_Bip_Name(); return TRUE; } /*-------------------------------------------------------------------------* * PL_COPY_TERM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Copy_Term_2(WamWord u_word, WamWord v_word) { WamWord word; int size; /* fix_bug is because when gcc sees &xxx where xxx is a fct argument variable * it allocates a frame even with -fomit-frame-pointer. * This corrupts ebp on ix86 */ static WamWord fix_bug; size = Pl_Term_Size(u_word); fix_bug = u_word; Pl_Copy_Term(H, &fix_bug); word = *H; H += size; return Pl_Unify(word, v_word); } /*-------------------------------------------------------------------------* * PL_SETARG_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Setarg_4(WamWord arg_no_word, WamWord term_word, WamWord new_value_word, WamWord undo_word) { WamWord word, tag_mask; int func, arity; int undo; WamWord *arg_adr; int arg_no; arg_adr = Pl_Rd_Compound_Check(term_word, &func, &arity); arg_no = Pl_Rd_Positive_Check(arg_no_word) - 1; undo = Pl_Rd_Boolean_Check(undo_word); DEREF(new_value_word, word, tag_mask); if (!undo && tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK) Pl_Err_Type(pl_type_atomic, word); /* pl_type_atomic but float not allowed */ if ((unsigned) arg_no >= (unsigned) arity) return FALSE; if (undo) Bind_OV((arg_adr + arg_no), word); else arg_adr[arg_no] = word; return TRUE; } /*-------------------------------------------------------------------------* * PL_TERM_REF_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Ref_2(WamWord term_word, WamWord ref_word) { WamWord word, tag_mask; WamWord word1, *adr; int ref; /* my own DEREF here to get the address */ adr = NULL; /* added this */ word = term_word; do { word1 = word; tag_mask = Tag_Mask_Of(word); if (tag_mask != TAG_REF_MASK) break; adr = UnTag_REF(word); /* added this */ word = *adr; } while (word != word1); if (tag_mask == TAG_REF_MASK) { ref = Pl_Rd_Positive_Check(ref_word); adr = Global_Stack + ref; return Pl_Unify(word, *adr); } if (adr < Global_Stack || adr > H) { adr = H; Global_Push(word); } ref = Global_Offset(adr); return Pl_Un_Positive_Check(ref, ref_word); } /*-------------------------------------------------------------------------* * PL_TERM_VARIABLES_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Variables_3(WamWord start_word, WamWord list_word, WamWord tail_word) { PlLong *p; /* only check if no Tail since if there is no vars in Term * then List = Tail and Tail can be any term */ if (tail_word == NOT_A_WAM_WORD) Pl_Check_For_Un_List(list_word); var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores variables */ Pl_Treat_Vars_Of_Term(start_word, TRUE, Collect_Variable); for(p = pl_glob_dico_var; p < var_ptr; p++) { if (!Pl_Get_List(list_word) || !Pl_Unify_Value(*p)) return FALSE; list_word = Pl_Unify_Variable(); } if (tail_word == NOT_A_WAM_WORD) return Pl_Get_Nil(list_word); return Pl_Unify(list_word, tail_word); } /*-------------------------------------------------------------------------* * PL_TERM_VARIABLES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Variables_2(WamWord start_word, WamWord list_word) { return Pl_Term_Variables_3(start_word, list_word, NOT_A_WAM_WORD); } /*-------------------------------------------------------------------------* * COLLECT_VARIABLE * * * *-------------------------------------------------------------------------*/ static Bool Collect_Variable(WamWord *adr) { PlLong *p; for (p = pl_glob_dico_var; p < var_ptr; p++) if (*p == (PlLong) adr) /* already present */ return TRUE; if (var_ptr - pl_glob_dico_var >= MAX_VAR_IN_TERM) Pl_Err_Representation(pl_representation_too_many_variables); *var_ptr++ = (PlLong) adr; return TRUE; } /*-------------------------------------------------------------------------* * PL_SUBSUMES_TERM_2 * * * * mostly implements: * * * * subsumes_term(Generic, Specific) :- * * \+ \+ subsumes(Generic, Specific). * * * * subsumes(General, Specific) :- * * term_variables(Specific, SVars), * * unify_with_occurs_check(General, Specific), * * term_variables(SVars, SVars2), * * SVars == SVars2. * * * * TODO: what to do with FD vars ? (a var subsumes a FD var, what else ?) * *-------------------------------------------------------------------------*/ Bool Pl_Subsumes_Term_2(WamWord general_word, WamWord specific_word) { Bool ret = FALSE;; Pl_Defeasible_Open(); base_var_ptr = var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores variables */ Pl_Treat_Vars_Of_Term(specific_word, TRUE, Collect_Variable); /* TODO: improve FD vars (possible ?) */ ret = Pl_Unify_Occurs_Check(general_word, specific_word) && Pl_Treat_Vars_Of_Term(specific_word, TRUE, Check_Variable) && base_var_ptr == var_ptr; Pl_Defeasible_Close(FALSE); /* undo bindings */ return ret; } /*-------------------------------------------------------------------------* * CHECK_VARIABLE * * * *-------------------------------------------------------------------------*/ static Bool Check_Variable(WamWord *adr, WamWord var_word) { WamWord word, tag_mask; WamWord *adr1; PlLong *p; if (Tag_Of(var_word) == FDV) /* improve FDV */ return FALSE; for (p = pl_glob_dico_var; p < base_var_ptr; p++) /* check if already found until now */ if (*p == (PlLong) adr) /* test if already present (thus well dereferenced) */ return TRUE; if (base_var_ptr >= var_ptr) return FALSE; /* not found */ /* check if Specific has been modified (also deref which is important) */ DEREF(*base_var_ptr, word, tag_mask); if (Tag_Of(word) != REF) /* TODO: treat FD vars */ return FALSE; /* specific has been instantiated - no longer a var */ adr1 = UnTag_REF(word); /* save dereferenced adr */ if (adr1 != adr) /* check if it is the current variable */ return FALSE; /* not ok */ *base_var_ptr = (PlLong) adr1; /* replace adr by dereferenced adr */ base_var_ptr++; return TRUE; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/debugger.pl����������������������������������������������������������������0000644�0001750�0001750�00000067367�13021324543�015443� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : debugger.pl * * Descr.: debugger * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$init_debugger' :- % called by Debug_Initializer() '$sys_var_write'(13, 1), % debugger is present DebugInfo = d(0, []), g_link('$debug_info', DebugInfo), '$debug_switch_off'. '$debug_switch_off' :- g_assign('$debug_mode', nodebug), g_assign('$debug_next', nodebug), g_assign('$debug_leash', 31), g_assign('$debug_depth', 10), '$call_c'('Pl_Reset_Debug_Call_Code_0'). '$debug_switch_on'(DebugMode) :- g_assign('$debug_mode', DebugMode), g_assign('$debug_next', DebugMode), g_read('$debug_info', DebugInfo), setarg(1, DebugInfo, 0, false), setarg(2, DebugInfo, [], false), '$call_c'('Pl_Set_Debug_Call_Code_0'). % Debugger built-in predicates wam_debug :- set_bip_name(wam_debug, 0), '$call_c'('Pl_Debug_Wam'). notrace :- set_bip_name(notrace, 0), nodebug. nodebug :- set_bip_name(nodebug, 0), '$debug_switch_off', '$show_debugger_mode'. trace :- set_bip_name(trace, 0), '$debug_switch_on'(trace), '$show_debugger_mode'. debug :- set_bip_name(debug, 0), '$debug_switch_on'(debug), '$show_debugger_mode'. '$show_debugger_mode' :- g_read('$debug_mode', DebugMode), '$show_debugger_mode1'(DebugMode), nl(debugger_output). '$show_debugger_mode1'(nodebug) :- write(debugger_output, 'The debugger is switched off'). '$show_debugger_mode1'(trace) :- write(debugger_output, 'The debugger will first creep -- '), write(debugger_output, 'showing everything (trace)'). '$show_debugger_mode1'(debug) :- write(debugger_output, 'The debugger will first leap -- '), write(debugger_output, 'showing spypoints (debug)'). debugging :- set_bip_name(debugging, 0), '$show_debugger_mode', '$show_leashing_info', '$show_undefined_action', '$show_spy_points'. leash(L) :- set_bip_name(leash, 1), var(L), !, '$pl_err_instantiation'. leash(full) :- !, leash([call, exit, redo, fail, exception]). leash(half) :- !, leash([call, redo]). leash(loose) :- !, leash([call]). leash(none) :- !, leash([]). leash(tight) :- !, leash([call, redo, fail, exception]). leash(L) :- '$leash_make_mask'(L, LeashMask), !, g_assign('$debug_leash', LeashMask), '$show_leashing_info'. leash(L) :- '$pl_err_domain'(leash_ports, L). '$leash_make_mask'([], 0). '$leash_make_mask'([Port|L], LeashMask1) :- '$leash_make_mask'(L, LeashMask), '$debug_port_mask'(Port, Mask), LeashMask1 is LeashMask \/ Mask. '$show_leashing_info' :- g_read('$debug_leash', LeashMask), '$show_leashing_info1'(LeashMask), nl(debugger_output). '$show_leashing_info1'(0) :- !, write(debugger_output, 'No leashing'). '$show_leashing_info1'(LeashMask) :- write(debugger_output, 'Using leashing stopping at '), g_assign('$debug_work', 91), '$show_leashing_info2'(LeashMask), write(debugger_output, '] ports'). '$show_leashing_info2'(LeashMask) :- '$debug_port_mask'(Port, Mask), LeashMask /\ Mask > 0, g_read('$debug_work', C), g_assign('$debug_work', 44), format(debugger_output, '~c~a', [C, Port]), fail. '$show_leashing_info2'(_). '$debug_is_not_leashed'(Port) :- g_read('$debug_leash', LeashMask), '$debug_port_mask'(Port, Mask), Mask /\ LeashMask =:= 0 . '$debug_port_mask'(call, 1). '$debug_port_mask'(exit, 2). '$debug_port_mask'(redo, 4). '$debug_port_mask'(fail, 8). '$debug_port_mask'(exception, 16). '$show_undefined_action' :- current_prolog_flag(unknown, Action), write(debugger_output, 'Undefined predicates will '), '$show_undefined_action1'(Action), nl(debugger_output). '$show_undefined_action1'(error) :- write(debugger_output, 'raise an existence_error'). '$show_undefined_action1'(warning) :- write(debugger_output, 'display a warning message and fail'). '$show_undefined_action1'(fail) :- write(debugger_output, fail). :- meta_predicate(spypoint_condition(:, ?, ?)). spypoint_condition(MGoal, Port, Test) :- set_bip_name(spypoint_condition, 3), '$strip_module_nonvar'(MGoal, Module, Goal), '$spypoint_condition1'(Goal, Module, Port, Test). '$spypoint_condition1'(Goal, _, _, _) :- var(Goal), !, '$pl_err_instantiation'. '$spypoint_condition1'(Goal, Module, Port, Test) :- callable(Goal), !, '$spypoint_condition2'(Goal, Module, Port, Test). '$spypoint_condition1'(Goal, _, _, _) :- '$pl_err_type'(callable, Goal). '$spypoint_condition2'(Goal, HomeModule, Port, Test) :- functor(Goal, F, A), ( '$get_module_of_pred'(HomeModule, F, A, Module) -> '$debug_spy_set'([Module:F/A], c(Goal, Port, Test)), g_read('$debug_mode', nodebug), debug ; '$debug_qualify_pi_pretty'(F, A, HomeModule, PI), format(debugger_output, 'Warning: The predicate ~q is undefined~n', [PI]) ), fail. '$spypoint_condition2'(_, _, _, _). :- meta_predicate(spy(:)). spy(MSpec) :- set_bip_name(spy, 1), '$strip_module_nonvar'(MSpec, Module, Spec), '$debug_list_of_pred'(Spec, Module, L), '$debug_spy_set'(L, _), L \== [], g_read('$debug_mode', nodebug), debug, fail. spy(_). :- meta_predicate(nospy(:)). nospy(MSpec) :- set_bip_name(nospy, 1), '$strip_module_nonvar'(MSpec, Module, Spec), '$debug_list_of_pred'(Spec, Module, L), '$debug_spy_reset'(L), fail. nospy(_). nospyall :- set_bip_name(nospyall, 0), retractall('$debug_spy_point'(_, _, _, _)), write(debugger_output, 'All spypoints removed'), nl(debugger_output), fail. nospyall. '$debug_spy_set'([], _). '$debug_spy_set'([Module:F/A|L], Cond) :- ( retract('$debug_spy_point'(F, A, Module, _)) -> Msg = 'There is already a spypoint on' ; Msg = 'Spypoint placed on' ), assertz('$debug_spy_point'(F, A, Module, Cond)), '$debug_qualify_pi_pretty'(F, A, Module, PI), format(debugger_output, '~a ~q~n', [Msg, PI]), !, '$debug_spy_set'(L, Cond). '$debug_spy_reset'([]). '$debug_spy_reset'([Module:F/A|L]) :- ( retract('$debug_spy_point'(F, A, Module, _)) -> Msg = 'Spypoint removed from' ; Msg = 'There is no spypoint on' ), '$debug_qualify_pi_pretty'(F, A, Module, PI), format(debugger_output, '~a ~q~n', [Msg, PI]), !, '$debug_spy_reset'(L). '$has_spy_point'(Goal, Module, Cond) :- functor(Goal, F, A), clause('$debug_spy_point'(F, A, Module, Cond), _), !. '$has_no_spy_point'(Goal, Module) :- functor(Goal, F, A), clause('$debug_spy_point'(F, A, Module, _), _), !, fail. '$has_no_spy_point'(_, _). '$spy_test_condition'(Goal, Module, Port, c(Goal, Port, Test)) :- %format('Spypoint test condition: goal ~q:~q port: ~w test: ~q~n', [Module, Goal, Port, Test]), ( var(Test) -> true ; '$call_no_debug'(Test, Module, spy_conditional, 1), ! ). '$show_spy_points' :- write(debugger_output, 'Spypoints:'), nl(debugger_output), clause('$debug_spy_point'(F, A, Module, _), _), '$debug_qualify_pi_pretty'(F, A, Module, PI), format(debugger_output, ' ~q~n', [PI]), fail. '$show_spy_points'. '$debug_list_of_pred'(Spec, _, _) :- var(Spec), !, '$pl_err_instantiation'. '$debug_list_of_pred'([], _, []) :- !. '$debug_list_of_pred'([Spec|Specs], Module, L) :- '$debug_list_of_pred_one'(Spec, Module, L1), '$debug_list_of_pred'(Specs, Module, L2), append(L1, L2, L), !. '$debug_list_of_pred'(Spec, Module, L) :- '$debug_list_of_pred_one'(Spec, Module, L). '$debug_list_of_pred_one'(Spec, _, _) :- var(Spec), !, '$pl_err_instantiation'. '$debug_list_of_pred_one'(MSpec, _, L) :- functor(MSpec, :, 2), !, '$strip_module_nonvar'(MSpec, Module, Spec), '$debug_list_of_pred_one'(Spec, Module, L). '$debug_list_of_pred_one'(F/A1 - A2, Module, L) :-% be cool ! accept F/(A1-A2) and (F/A1)-A2 atom(F), !, '$debug_list_of_pred_one1'(F, A1, A2, Module, L). '$debug_list_of_pred_one'(F/(A1 - A2), Module, L) :- % be cool ! accept F/(A1-A2) and (F/A1)-A2 atom(F), !, '$debug_list_of_pred_one1'(F, A1, A2, Module, L). '$debug_list_of_pred_one'(F, Module, L) :- atom(F), !, current_prolog_flag(max_arity, Max), '$debug_list_of_pred_one1'(F, 0, Max, Module, L). '$debug_list_of_pred_one'(PI, Module, L) :- '$get_pred_indic'(PI, Module, Module1, F, A), % Module = Module1 in fact '$debug_list_of_pred_one1'(F, A, A, Module1, L). '$debug_list_of_pred_one1'(F, _, _, _, _) :- var(F), !, '$pl_err_instantiation'. '$debug_list_of_pred_one1'(_, A1, _, _, _) :- var(A1), !, '$pl_err_instantiation'. '$debug_list_of_pred_one1'(_, _, A2, _, _) :- var(A2), !, '$pl_err_instantiation'. '$debug_list_of_pred_one1'(F, A1, A2, Module, L) :- current_prolog_flag(max_arity, Max), integer(A1), integer(A2), A1 >= 0, A1 =< Max, A2 >= 0, A2 =< Max, g_assign('$debug_work', []), ( '$current_predicate_any'(Module:F/A), A >= A1, A =< A2, g_read('$debug_work', X), '$get_module_of_pred'(Module, F, A, Module1), g_assign('$debug_work', [Module1:F/A|X]), fail ; g_read('$debug_work', L) ), ( L = [], ( A1 = A2 -> Z0 = F/A1 ; A1 = 0 -> A2 = Max, Z0 = F/any ; Z0 = F/A1 - A2 ), ( var(Module) -> Z = Z0 ; Z = Module:Z0 ), format(debugger_output, 'Warning: spy ~q - no matching predicate~n', [Z]), fail ; true ). % The debugger: % % '$debug_call'/2 is called by meta-call (cf bc_supp.c) when the % debugger is active, ie. Set_Debug_Call_Code() has been called '$debug_call'(notrace, _, _) :- !, notrace. '$debug_call'(nodebug, _, _) :- !, nodebug. '$debug_call'(trace, _, _) :- !, trace. '$debug_call'(debug, _, _) :- !, debug. '$debug_call'(debugging, _, _) :- !, debugging. '$debug_call'(leash(L), _, _) :- !, leash(L). '$debug_call'(spy(Spec), Module, _) :- !, spy(Module:Spec). '$debug_call'(spypoint_condition(Goal, Port, Test), Module, _) :- !, spypoint_condition(Module:Goal, Port, Test). '$debug_call'(nospy(Spec), Module, _) :- !, nospy(Module:Spec). '$debug_call'(nospyall, _, _) :- !, nospyall. '$debug_call'(Goal, Module0, CallInfo) :- %format('$debug_call Goal:~w Module: ~w~n',[Goal, Module0]), ( '$get_module_of_goal_if_not_meta_pred'(Module0, Goal, Module) -> true ; Module = Module0 ), g_read('$debug_info', DebugInfo), DebugInfo = d(Invoc, OldAncLst), ( OldAncLst = [] -> Index = 0 ; OldAncLst = [a(_, _, _, Index, _)|_] ), Invoc1 is Invoc + 1, Index1 is Index + 1, '$get_current_B'(B), NewAncLst = [a(Goal, Module, Invoc1, Index1, B)|OldAncLst], setarg(1, DebugInfo, Invoc1), setarg(2, DebugInfo, NewAncLst), %format('starting of call ~w',[Module:Goal]), disp_B(''), '$debug_call1'(Goal, Module, CallInfo, Invoc1, Index1, NewAncLst, DebugInfo, Invoc, OldAncLst). %disp_B(Msg):- '$get_current_B'(B), format(' ~w B:%d (%#x)\n', [Msg, B, B]). '$debug_call1'(Goal, Module, CallInfo, Invoc1, Index1, NewAncLst, DebugInfo, _, OldAncLst) :- %format('goal is ~w Call Info:~w~n', [Module:Goal, CallInfo]), '$get_current_B'(B), '$catch_internal'('$debug_call_port'(Goal, Module, CallInfo, Invoc1, Index1, NewAncLst), Ball, '$debug_exception_port'(Goal, Module, Invoc1, Index1, NewAncLst, Ball), system, 0), '$get_current_B'(B1), %format(' after effective call: ~w B(start):%#x B1(end):%#x~n', [Module:Goal, B, B1]), %disp_B('before end call'), '$debug_end_call'(Goal, Module, Invoc1, Index1, NewAncLst, DebugInfo, OldAncLst), %disp_B('after end call and before test determin'), ( B1 =< B, ! ; true ). %disp_B('after cut if determin'). '$debug_call1'(Goal, Module, _, Invoc1, Index1, NewAncLst, _, _, _) :- %format('the call to ~w failed~n', [Module:Goal]), '$debug_port'(Goal, Module, Invoc1, Index1, NewAncLst, fail), fail. '$debug_call1'(Goal, Module, CallInfo, Invoc1, _, _, DebugInfo, Invoc, OldAncLst) :- g_read('$debug_next', retry(X)), % if user asked a 'retry' X >= Invoc1, setarg(1, DebugInfo, Invoc), setarg(2, DebugInfo, OldAncLst), g_assign('$debug_next', trace), '$debug_call'(Goal, Module, CallInfo). '$debug_call_port'(Goal, Module, CallInfo, Invoc, Index, AncLst) :- g_assign('$debug_unify', ''), '$debug_port'(Goal, Module, Invoc, Index, AncLst, call), g_read('$debug_unify', DebugUnify), ( DebugUnify == '' -> %format('now I call ~w~n', [Module:Goal]), Goal \== fail, % NB: bc_supp.c calls the debugger for 'fail/0'. % but don't call 'call_from_debugger since it is a % control-construct (thus its native codep == NULL) '$call_from_debugger'(Goal, Module, CallInfo) %,g_read('$debug_next', DebugNext),format('now I exit ~w debug_next:~w~n', [Module:Goal,DebugNext]) ; Goal = DebugUnify ). '$debug_end_call'(Goal, Module, Invoc1, Index1, AncLst, DebugInfo, OldAncLst) :- %write('in end call'(Goal)),nl, '$debug_port'(Goal, Module, Invoc1, Index1, AncLst, exit), setarg(2, DebugInfo, OldAncLst). '$debug_end_call'(Goal, Module, Invoc1, Index1, AncLst, _, _) :- '$debug_port'(Goal, Module, Invoc1, Index1, AncLst, redo), fail. '$debug_exception_port'(Goal, Module, Invoc, Index, AncLst, Ball) :- g_assign('$debug_ball', Ball), '$debug_port'(Goal, Module, Invoc, Index, AncLst, exception), throw(Ball). % debug_port '$debug_port'(Goal, Module, Invoc, Index, AncLst, Port) :- '$get_current_B'(B), '$debug_port1'(Goal, Module, Invoc, Index, AncLst, Port, B). '$debug_port1'(Goal, Module, Invoc, Index, AncLst, Port, B) :- '$debug_port2'(Goal, Module, Invoc, Index, AncLst, Port, B), fail. '$debug_port1'(_, _, _, _, _, _, _) :- g_read('$debug_next', DebugNext), % fail for 'r' and 'f' %format('$debug_next = ~w~n', [DebugNext]), atom(DebugNext). '$debug_port2'(Goal, Module, Invoc, _, _, Port, _) :- g_read('$debug_next', DebugNext), %format(' test port_ignore debug_next:~w~n', [DebugNext]), '$debug_port_ignore'(DebugNext, Goal, Module, Invoc, Port), !. '$debug_port2'(Goal, Module, Invoc, Index, AncLst, Port, B) :- '$debug_port_prompt'(Goal, Module, Invoc, Index, AncLst, Port, B). '$debug_port_ignore'(nodebug, _, _, _, _). '$debug_port_ignore'(debug, Goal, Module, _, _) :- '$has_no_spy_point'(Goal, Module). '$debug_port_ignore'(debug, Goal, Module, _, Port) :- '$has_spy_point'(Goal, Module, Cond), %format('Port: ~w spypoint on ~w:~q with condition: ~q~n', [Port, Module, Goal, Cond]), ( '$spy_test_condition'(Goal, Module, Port, Cond) -> fail ; true ). '$debug_port_ignore'(skip, _, _, Invoc, Port) :- g_read('$debug_skip', s(Invoc1, Mask1)), '$debug_port_mask'(Port, Mask), ( Invoc = Invoc1, Mask /\ Mask1 > 0 -> fail ; ! ). '$debug_port_ignore'(fail(Invoc1), _, _, Invoc, Port) :- ( Invoc > Invoc1 ; Port \== fail ), !. '$debug_port_ignore'(retry(_), _, _, _, _). '$debug_port_prompt'(Goal, Module, Invoc, Index, AncLst, Port, B) :- repeat, g_assign('$debug_next', trace), '$debug_write_goal'(Goal, Module, Invoc, Index, Port), ( '$has_no_spy_point'(Goal, Module), '$debug_is_not_leashed'(Port) -> nl(debugger_output) ; '$debug_read_cmd'(C), '$debug_exec_cmd'(C, Goal, Module, Invoc, AncLst, Port, B) ), !. '$debug_read_cmd'(C) :- write(debugger_output, ' ? '), flush_output(debugger_output), get_key(debugger_input, X), X >= 0, X < 255, char_code(C, X), format(debugger_output, '~N', []). '$debug_read_integer'(X) :- read_integer(debugger_input, X), repeat, get_code(debugger_input, 10), !. % the last '\n' '$debug_exec_cmd'(C, Goal, Module, Invoc, AncLst, Port, B) :- char_code(C, X), X >= 10, X =< 13, '$debug_exec_cmd'(c, Goal, Module, Invoc, AncLst, Port, B). '$debug_exec_cmd'(c, _, _, _, _, _, _) :- % creep g_assign('$debug_next', trace). '$debug_exec_cmd'(l, _, _, _, _, _, _) :- % leap g_assign('$debug_next', debug). '$debug_exec_cmd'(s, Goal, Module, Invoc, AncLst, Port, B) :- % skip ( Port = exit ; Port = fail ; Port = exception ), !, '$debug_exec_cmd'(c, Goal, Module, Invoc, AncLst, Port, B). '$debug_exec_cmd'(s, _, _, Invoc, _, _, _) :- % skip g_assign('$debug_next', skip), '$debug_port_mask'(exit, Mask1), '$debug_port_mask'(fail, Mask2), '$debug_port_mask'(exception, Mask3), Mask is Mask1 \/ Mask2 \/ Mask3, g_assign('$debug_skip', s(Invoc, Mask)). '$debug_exec_cmd'('G', _, _, _, _, _, _) :- % goto write(debugger_output, 'Inovcation nb: '), '$debug_read_integer'(Invoc), g_assign('$debug_next', skip), g_assign('$debug_skip', s(Invoc, 31)). '$debug_exec_cmd'(r, _, _, _, _, call, _) :- % retry !, fail. '$debug_exec_cmd'(r, _, _, Invoc, _, _, _) :- % retry g_assign('$debug_next', retry(Invoc)). '$debug_exec_cmd'(f, _, _, _, _, fail, _) :- % fail !, fail. '$debug_exec_cmd'(f, _, _, Invoc, _, _, _) :- % fail g_assign('$debug_next', fail(Invoc)). '$debug_exec_cmd'(w, Goal, Module, _, _, _, _) :- % write '$debug_qualify_goal_pretty'(Goal, Module, Goal1), write(debugger_output, ' '), write(debugger_output, Goal1), nl(debugger_output), !, fail. '$debug_exec_cmd'(d, Goal, Module, _, _, _, _) :- % display '$debug_qualify_goal_pretty'(Goal, Module, Goal1), write(debugger_output, ' '), display(debugger_output, Goal1), nl(debugger_output), !, fail. '$debug_exec_cmd'(p, Goal, Module, _, _, _, _) :- % print '$debug_qualify_goal_pretty'(Goal, Module, Goal1), write(debugger_output, ' '), print(debugger_output, Goal1), nl(debugger_output), !, fail. '$debug_exec_cmd'(e, _, _, _, _, Port, _) :- % exception ( Port = exception -> g_read('$debug_ball', Ball), format(debugger_output, 'Exception raised: ~q~n', [Ball]) ; write(debugger_output, 'Option not applicable at this port'), nl(debugger_output) ), !, fail. '$debug_exec_cmd'(g, _, _, _, AncLst, _, _) :- % ancestors '$debug_disp_anc_lst'(AncLst), !, fail. '$debug_exec_cmd'('A', _, _, _, AncLst, _, B) :- % alternatives '$debug_disp_alternatives'(AncLst, B), !, fail. '$debug_exec_cmd'(u, _, _, _, _, Port, _) :- % unify ( Port = call -> write(debugger_output, 'Head: '), read(debugger_input, DebugUnify), g_assign('$debug_unify', DebugUnify) ; write(debugger_output, 'Option not applicable at this port'), nl(debugger_output), !, fail ). '$debug_exec_cmd'(n, _, _, _, _, _, _) :- % nodebug '$debug_switch_off'. '$debug_exec_cmd'(=, _, _, _, _, _, _) :- % debugging debugging, !, fail. '$debug_exec_cmd'('.', Goal, Module, _, _, _, _) :- % father file !, functor(Goal, F, A), ( '$get_predicate_file_info'(Module, F, A, PlFile, PlLine) -> format(debugger_output, '~a/~d defined in ~a:~d~n', [F, A, PlFile, PlLine]) ; format(debugger_output, 'no file information for ~a/~d~n', [F, A]) ), fail. '$debug_exec_cmd'(+, Goal, Module, _, _, _, _) :- % spy this functor(Goal, F, A), spy(Module:F/A), !, fail. '$debug_exec_cmd'(*, Goal, Module, _, _, _, _) :- % spy conditionally repeat, write(debugger_output, 'Goal,Port,Test: '), read(debugger_input, (Goal1, Port1, Test1)), callable(Goal1), functor(Goal, F, A), functor(Goal1, F, A), spypoint_condition(Module:Goal1, Port1, Test1), !, fail. '$debug_exec_cmd'(-, Goal, Module, _, _, _, _) :- % nospy this functor(Goal, F, A), nospy(Module:F/A), !, fail. '$debug_exec_cmd'('L', Goal, Module, _, _, _, _) :- % listing !, functor(Goal, F, A), PI = Module:F/A, ( '$current_predicate_any'(PI) -> ( '$predicate_property1'(Module, F, A, native_code) -> format(debugger_output, 'native code predicate ~a/~d~n', [F, A]) ; '$call_c'('Pl_Reset_Debug_Call_Code_0'), listing(PI), nl(debugger_output), '$call_c'('Pl_Set_Debug_Call_Code_0') ) ; format(debugger_output, 'cannot find any info on ~a/~d~n', [F, A]) ), fail. '$debug_exec_cmd'(a, _, _, _, _, _, _) :- % abort abort. '$debug_exec_cmd'(b, _, _, _, _, _, _) :- % break break, !, fail. '$debug_exec_cmd'(@, _, _, _, _, _, _) :- % command write(debugger_output, 'Command: '), read(debugger_input, Command), ( '$catch_no_debug'(Command, Err, format(debugger_output, 'Warning: ~q - exception raised ~w~n', [Command, Err]), user, debugger_exec_cmd, 1) -> true ; format(debugger_output, 'Warning: ~q - goal failed~n', [Command]) ), !, fail. '$debug_exec_cmd'(<, _, _, _, _, _, _) :- % print depth write(debugger_output, 'Print Depth: '), '$debug_read_integer'(Depth), g_assign('$debug_depth', Depth), !, fail. '$debug_exec_cmd'(?, _, _, _, _, _, _) :- % help '$debug_disp_help', !, fail. '$debug_exec_cmd'(h, _, _, _, _, _, _) :- % help '$debug_disp_help', !, fail. '$debug_exec_cmd'('W', _, _, _, _, _, _) :- % WAM debugger wam_debug, !, fail. '$debug_exec_cmd'(_, _, _, _, _, _, _) :- % error write(debugger_output, 'Unknown command (type h for help)'), nl(debugger_output), fail. '$debug_write_goal'(Goal, Module, Invoc, Index, Port) :- g_read('$debug_depth', Depth), ( '$has_no_spy_point'(Goal, Module) -> Indic = ' ' ; Indic = (+) ), '$debug_port_pretty'(Port, Port1), format(debugger_output, '~N ~a %4d %4d ~a', [Indic, Invoc, Index, Port1]), '$debug_qualify_goal_pretty'(Goal, Module, Goal1), write_term(debugger_output, Goal1, [quoted(true), max_depth(Depth)]). '$debug_qualify_pi_pretty'(F, A, Module, PI) :- % '$get_module_of_pred'(Module, F, A, Module1), '$debug_needs_module'(Module), !, PI = Module:F/A. '$debug_qualify_pi_pretty'(F, A, _, F/A). '$debug_qualify_goal_pretty'(Goal, Module, Goal1) :- % '$get_module_of_goal'(Module, Goal, Module1), '$debug_needs_module'(Module), !, Goal1 = Module:Goal. '$debug_qualify_goal_pretty'(Goal, _, Goal). '$debug_needs_module'(Module) :- Module \== user, Module \== system. '$debug_port_pretty'(call, 'Call: '). '$debug_port_pretty'(redo, 'Redo: '). '$debug_port_pretty'(fail, 'Fail: '). '$debug_port_pretty'(exit, 'Exit: '). '$debug_port_pretty'(exception, 'Exception: '). '$debug_port_pretty'(no_port, ''). '$debug_disp_anc_lst'([a(_, _, _, _, _)|AncLst]) :- write(debugger_output, 'Ancestors:'), nl(debugger_output), '$debug_disp_anc_lst1'(AncLst). '$debug_disp_anc_lst1'([]). '$debug_disp_anc_lst1'([a(Goal, Module, Invoc, Index, _)|AncLst]) :- '$debug_disp_anc_lst1'(AncLst), '$debug_write_goal'(Goal, Module, Invoc, Index, no_port). '$debug_disp_alternatives'(AncLst, B) :- write(debugger_output, 'Alternatives:'), nl(debugger_output), '$debug_disp_alternatives1'(AncLst, B), format(debugger_output, '~N--------------~n', []). '$debug_disp_alternatives1'([], _). '$debug_disp_alternatives1'([a(Goal, Module, Invoc, Index, B1)|AncLst], B2) :- '$debug_disp_alternatives1'(AncLst, B1), '$debug_write_goal'(Goal, Module, Invoc, Index, no_port), '$debug_disp_alt'(B2, B1). '$debug_disp_alt'(B, B) :- !. '$debug_disp_alt'(BFrom, BTo) :- '$choice_point_info'(BFrom, Module, F, A, B1), '$debug_disp_alt'(B1, BTo), '$pred_without_aux'(F, A, F1, A1), '$debug_disp_alt1'(Module, F1, A1, BFrom), !. '$debug_disp_alt1'(system, F, _, _) :- % hide debug alternatives '$debug_is_debug_predicate'(F). '$debug_disp_alt1'(_, _, _, B) :- % dynam clause selection ? '$call_c_test'('Pl_Scan_Choice_Point_Info_4'(B, Module, F, A)), % fail if not '$pred_without_aux'(F, A, F1, A1), '$debug_qualify_pi_pretty'(F1, A1, Module, PI), '$debug_disp_alt2'(PI). '$debug_disp_alt1'(system, '$catch_internal1', 6, B) :- % hide debug catch '$choice_point_arg'(B, 1, Goal), functor(Goal, F, _), '$debug_is_debug_predicate'(F). '$debug_disp_alt1'(system, '$trail_handler', 1, _). '$debug_disp_alt1'(Module, F, A, _) :- % detect system predicate sub_atom(F, 0, 1, _, $), '$predicate_property1'(Module, F, A, native_code), ( ( sub_atom(F, 1, _, 4, F1), '$debug_check_bip'(F1, A1) ; sub_atom(F, 1, _, 1, F1), '$debug_check_bip'(F1, A1) ) -> '$debug_disp_alt2'(F1/A1) ; '$debug_disp_alt2'('system predicate'(F/A)) ). '$debug_disp_alt1'(Module, F, A, _) :- % normal predicate '$debug_qualify_pi_pretty'(F, A, Module, PI), '$debug_disp_alt2'(PI). '$debug_disp_alt2'(X) :- format(debugger_output, '~N 1 choice-point for ~w~n', [X]). '$debug_is_debug_predicate'(F) :- sub_atom(F, 0, 7, _, '$debug_'). '$debug_check_bip'(F1, A1) :- '$predicate_property1'(user, F1, A1, built_in). /* useless since now built_in_fd ==> built_in '$debug_check_bip'(F1, A1) :- '$predicate_property1'(user, F1, A1, built_in_fd). */ '$debug_disp_help' :- format(debugger_output, 'Debugging commands:~n~n', []), format(debugger_output, 'RET/c creep l leap ~n', []), format(debugger_output, ' s skip G goto~n', []), format(debugger_output, ' r retry f fail~n', []), format(debugger_output, ' w write d display~n', []), format(debugger_output, ' p print e exception~n', []), format(debugger_output, ' g ancestors A alternatives~n', []), format(debugger_output, ' u unify . father file~n', []), format(debugger_output, ' n nodebug = debugging~n', []), format(debugger_output, ' + spy this * spy conditionally~n', []), format(debugger_output, ' - nospy this L listing~n', []), format(debugger_output, ' a abort b break~n', []), format(debugger_output, ' @ command < set printdepth~n', []), format(debugger_output, ' h/? help W WAM debugger~n', []), nl(debugger_output). '$choice_point_info'(B, M, F, A, LastB) :- '$call_c'('Pl_Choice_Point_Info_5'(B, M, F, A, LastB)). '$choice_point_arg'(B, I, Arg) :- '$call_c'('Pl_Choice_Point_Arg_3'(B, I, Arg)). �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/term_inl.pl����������������������������������������������������������������0000644�0001750�0001750�00000010314�13021324543�015444� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : term_inl.pl * * Descr.: term (inline) management - defs for meta-call * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_term_inl'. compare(C, T1, T2) :- compare(C, T1, T2). X == Y :- X == Y. X \== Y :- X \== Y. X @< Y :- X @< Y. X @=< Y :- X @=< Y. X @> Y :- X @> Y. X @>= Y :- X @>= Y. arg(N, T, A) :- arg(N, T, A). functor(T, F, N) :- functor(T, F, N). Term =.. List :- Term =.. List. /* these are not inlined but put here for practical reasons */ copy_term(T1, T2) :- set_bip_name(copy_term, 2), '$call_c_test'('Pl_Copy_Term_2'(T1, T2)). setarg(ArgNo, Term, NewValue) :- set_bip_name(setarg, 3), '$call_c_test'('Pl_Setarg_4'(ArgNo, Term, NewValue, true)). setarg(ArgNo, Term, NewValue, Undo) :- set_bip_name(setarg, 4), '$call_c_test'('Pl_Setarg_4'(ArgNo, Term, NewValue, Undo)). term_ref(Term, Ref) :- set_bip_name(term_ref, 2), '$call_c_test'('Pl_Term_Ref_2'(Term, Ref)). term_variables(Term, List) :- set_bip_name(term_variables, 2), '$call_c_test'('Pl_Term_Variables_2'(Term, List)). term_variables(Term, List, Tail) :- set_bip_name(term_variables, 3), '$call_c_test'('Pl_Term_Variables_3'(Term, List, Tail)). subsumes_term(General, Specific) :- set_bip_name(subsumes_term, 2), '$call_c_test'('Pl_Subsumes_Term_2'(General, Specific)). acyclic_term(X) :- set_bip_name(acyclic_term, 1), '$call_c_test'('Pl_Acyclic_Term_1'(X)). term_hash(X, Depth, Range, Hash) :- set_bip_name(term_hash, 4), '$call_c_test'('Pl_Term_Hash_4'(X, Depth, Range, Hash)). term_hash(X, Hash) :- set_bip_name(term_hash, 2), '$call_c_test'('Pl_Term_Hash_2'(X, Hash)). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/error_supp.h���������������������������������������������������������������0000644�0001750�0001750�00000026661�13021324543�015663� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : error_supp.h * * Descr.: Prolog errors support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef ERROR_SUPP_FILE int pl_type_atom; int pl_type_atomic; int pl_type_byte; int pl_type_callable; int pl_type_character; int pl_type_compound; int pl_type_evaluable; int pl_type_float; /* for arithmetic */ int pl_type_boolean; /* for setarg/4 */ int pl_type_in_byte; int pl_type_in_character; int pl_type_integer; int pl_type_list; int pl_type_number; int pl_type_predicate_indicator; int pl_type_variable; /* deprecated: new code should emit an uninstantiation_error */ int pl_type_pair; int pl_type_fd_variable; /* for FD */ int pl_type_fd_evaluable; /* for FD */ int pl_type_fd_bool_evaluable; /* for FD */ int pl_domain_character_code_list; int pl_domain_close_option; int pl_domain_flag_value; int pl_domain_io_mode; int pl_domain_non_empty_list; int pl_domain_not_less_than_zero; int pl_domain_operator_priority; int pl_domain_operator_specifier; int pl_domain_prolog_flag; int pl_domain_read_option; int pl_domain_source_sink; int pl_domain_stream; int pl_domain_stream_option; int pl_domain_stream_or_alias; int pl_domain_stream_position; int pl_domain_stream_property; int pl_domain_write_option; int pl_domain_order; int pl_domain_term_stream_or_alias; /* for term_streams */ int pl_domain_g_array_index; /* for g_vars */ int pl_domain_g_argument_selector; /* for g_vars */ int pl_domain_stream_seek_method; /* for seek/4 */ int pl_domain_format_control_sequence; /* for format/2-3 */ int pl_domain_os_path; /* for absolute_file_name/2 */ int pl_domain_os_file_permission; /* for file_permission/2 */ int pl_domain_selectable_item; /* for select_read/3 */ int pl_domain_date_time; /* for os_interf */ #ifndef NO_USE_SOCKETS int pl_domain_socket_domain; /* for sockets */ int pl_domain_socket_address; /* for sockets */ #endif int pl_existence_procedure; int pl_existence_source_sink; int pl_existence_stream; int pl_existence_sr_descriptor; /* for source reader */ int pl_permission_operation_access; int pl_permission_operation_close; int pl_permission_operation_create; int pl_permission_operation_input; int pl_permission_operation_modify; int pl_permission_operation_open; int pl_permission_operation_output; int pl_permission_operation_reposition; int pl_permission_operation_execute; int pl_permission_type_binary_stream; int pl_permission_type_flag; int pl_permission_type_operator; int pl_permission_type_past_end_of_stream; int pl_permission_type_private_procedure; int pl_permission_type_static_procedure; int pl_permission_type_source_sink; int pl_permission_type_stream; int pl_permission_type_text_stream; int pl_permission_type_non_exported_procedure; int pl_representation_character; int pl_representation_character_code; int pl_representation_in_character_code; int pl_representation_max_arity; int pl_representation_max_integer; int pl_representation_min_integer; int pl_representation_too_many_variables; /* for Pl_Copy_Term(),... */ int pl_evluation_float_overflow; int pl_evluation_int_overflow; int pl_evluation_undefined; int pl_evluation_underflow; int pl_evluation_zero_divisor; int pl_resource_print_object_not_linked; /* for print and format */ int pl_resource_too_big_fd_constraint; /* for FD */ #else extern int pl_type_atom; extern int pl_type_atomic; extern int pl_type_byte; extern int pl_type_callable; extern int pl_type_character; extern int pl_type_compound; extern int pl_type_evaluable; extern int pl_type_float; /* for arithmetic */ extern int pl_type_boolean; /* for setarg/4 */ extern int pl_type_in_byte; extern int pl_type_in_character; extern int pl_type_integer; extern int pl_type_list; extern int pl_type_number; extern int pl_type_predicate_indicator; extern int pl_type_variable; /* deprecated: new code should emit an uninstantiation_error */ extern int pl_type_pair; extern int pl_type_fd_variable; /* for FD */ extern int pl_type_fd_evaluable; /* for FD */ extern int pl_type_fd_bool_evaluable; /* for FD */ extern int pl_domain_character_code_list; extern int pl_domain_close_option; extern int pl_domain_flag_value; extern int pl_domain_io_mode; extern int pl_domain_non_empty_list; extern int pl_domain_not_less_than_zero; extern int pl_domain_operator_priority; extern int pl_domain_operator_specifier; extern int pl_domain_prolog_flag; extern int pl_domain_read_option; extern int pl_domain_source_sink; extern int pl_domain_stream; extern int pl_domain_stream_option; extern int pl_domain_stream_or_alias; extern int pl_domain_stream_position; extern int pl_domain_stream_property; extern int pl_domain_write_option; extern int pl_domain_order; extern int pl_domain_term_stream_or_alias; /* for term_streams */ extern int pl_domain_g_array_index; /* for g_vars */ extern int pl_domain_g_argument_selector; /* for g_vars */ extern int pl_domain_stream_seek_method; /* for seek/4 */ extern int pl_domain_format_control_sequence; /* for format/2-3 */ extern int pl_domain_os_path; /* for absolute_file_name/2 */ extern int pl_domain_os_file_permission; /* for file_permission/2 */ extern int pl_domain_selectable_item; /* for select_read/3 */ extern int pl_domain_date_time; /* for os_interf */ #ifndef NO_USE_SOCKETS extern int pl_domain_socket_domain; /* for sockets */ extern int pl_domain_socket_address; /* for sockets */ #endif extern int pl_existence_procedure; extern int pl_existence_source_sink; extern int pl_existence_stream; extern int pl_existence_sr_descriptor; /* for source reader */ extern int pl_permission_operation_access; extern int pl_permission_operation_close; extern int pl_permission_operation_create; extern int pl_permission_operation_input; extern int pl_permission_operation_modify; extern int pl_permission_operation_open; extern int pl_permission_operation_output; extern int pl_permission_operation_reposition; extern int pl_permission_operation_execute; extern int pl_permission_type_binary_stream; extern int pl_permission_type_flag; extern int pl_permission_type_operator; extern int pl_permission_type_past_end_of_stream; extern int pl_permission_type_private_procedure; extern int pl_permission_type_static_procedure; extern int pl_permission_type_source_sink; extern int pl_permission_type_stream; extern int pl_permission_type_text_stream; extern int pl_permission_type_non_exported_procedure; extern int pl_representation_character; extern int pl_representation_character_code; extern int pl_representation_in_character_code; extern int pl_representation_max_arity; extern int pl_representation_max_integer; extern int pl_representation_min_integer; extern int pl_representation_too_many_variables;/* for Pl_Copy_Term(),... */ extern int pl_evluation_float_overflow; extern int pl_evluation_int_overflow; extern int pl_evluation_undefined; extern int pl_evluation_underflow; extern int pl_evluation_zero_divisor; extern int resource_too_many_open_streams; /* for streams */ extern int pl_resource_print_object_not_linked; /* for print and format */ extern int pl_resource_too_big_fd_constraint; /* for FD */ #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Set_Bip_Name_2(WamWord func_word, WamWord arity_word); void Pl_Set_Bip_Name_Untagged_2(int func, int arity); void Pl_Set_C_Bip_Name(char *func_str, int arity); void Pl_Unset_C_Bip_Name(void); int Pl_Get_Current_Bip(int *arity); void Pl_Set_Last_Syntax_Error(char *file_name, int err_line, int err_col, char *err_msg); void Pl_Syntax_Error(int flag_value); WamWord Pl_Build_Pred_Indic_Error0(int module, int func, int arity); WamWord Pl_Build_Pred_Indic_Error(PredInf *pred); void Pl_Unknown_Pred_Error(int module, int func, int arity); void Pl_Os_Error(int ret_val); void Pl_Err_Instantiation(void); void Pl_Err_Uninstantiation(WamWord term); void Pl_Err_Type(int atom_type, WamWord term); void Pl_Err_Domain(int atom_domain, WamWord term); void Pl_Err_Existence(int atom_object, WamWord term); void Pl_Err_Permission(int atom_oper, int atom_perm, WamWord term); void Pl_Err_Representation(int atom_flag); void Pl_Err_Evaluation(int pl_atom_error); void Pl_Err_Resource(int atom_resource); void Pl_Err_Syntax(int pl_atom_error); void Pl_Err_System(int pl_atom_error); #define Os_Test_Error_Null(tst) \ do { \ if ((tst) == NULL) \ { \ Pl_Os_Error(-1); \ return FALSE; \ } \ } while(0) #define Os_Test_Error(tst) \ do { \ int _tst = (tst); \ if (_tst < 0) \ { \ Pl_Os_Error(_tst); \ return FALSE; \ } \ } while(0) �������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/catch.pl�������������������������������������������������������������������0000644�0001750�0001750�00000012507�13021324543�014723� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : catch.pl * * Descr.: exception management (catch) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_catch'. '$catch'(Goal, Catch, Recovery, Module, CallerFunc, CallerArity) :- '$call_c'('Pl_Save_Call_Info_3'(CallerFunc, CallerArity, 1)), '$catch1'(Goal, Catch, Recovery, Module, 0). '$catch_no_debug'(Goal, Catch, Recovery, Module, CallerFunc, CallerArity) :- '$call_c'('Pl_Save_Call_Info_3'(CallerFunc, CallerArity, 0)), '$catch1'(Goal, Catch, Recovery, Module, 0). '$catch1'(Goal, Catch, Recovery, Module, CallInfo) :- '$call_c'('Pl_Load_Call_Info_Arg_1'(4)), % to ensure CallInfo is deref '$catch_internal'(Goal, Catch, Recovery, Module, CallInfo). % Warning the name '$catch_internal1' is tested by the debugger '$catch_internal'(Goal, Catch, Recovery, Module, CallInfo) :- '$sys_var_read'(7, Handler), '$sys_var_put'(8, '$no_ball$'), '$catch_internal1'(Goal, Catch, Recovery, Module, CallInfo, Handler). '$catch_internal1'(Goal, _Catch, _Recovery, Module, CallInfo, Handler) :- '$get_current_B'(B), '$sys_var_write'(7, B), % for debug % format('~N*** ~d for catch(~w,~w,~w)~n', [B, Goal, _Catch, _Recovery]), '$call_internal'(Goal, Module, CallInfo), '$get_current_B'(B1), ( B1 > B -> '$trail_handler'(B) ; ! ), '$sys_var_write'(7, Handler). % for debug % '$catch_internal1'(_, _, _, _, _, _):- % '$get_current_B'(B), % '$sys_var_get'(8, Ball), % format('~N*** ~d catching throw(~w)~n', [B, Ball]), % fail. '$catch_internal1'(_, Catch, Recovery, Module, CallInfo, Handler) :- '$sys_var_write'(7, Handler), % after throw or fail '$sys_var_get'(8, Ball), Ball \== '$no_ball$', '$catch_a_throw'(Ball, Catch, Recovery, Module, CallInfo, Handler). '$catch_a_throw'(Ball, _, _, _, _, Handler) :- % for abort % for debug % write(catch(Ball, Handler)), nl, nonvar(Ball), Ball = '$catch_sync'(B), !, ( Handler > B -> '$unwind'('$catch_sync'(B)) ; '$catch_fail_now'(B) ). '$catch_a_throw'(Ball, Ball1, Recovery, Module, CallInfo, _) :- % for debug %write(catch1(Ball, Ball1, Recovery)), nl, Ball = Ball1, % for debug % write(catch2(Ball, Ball1, Recovery)), nl, !, % normal throw - unifies '$sys_var_put'(8, '$no_ball$'), '$call_internal'(Recovery, Module, CallInfo). '$catch_a_throw'(Ball, _, _, _, _, _) :- % normal throw - does not unify '$unwind'(Ball). '$trail_handler'(_). '$trail_handler'(Handler) :- '$sys_var_write'(7, Handler), fail. '$catch_sync_for_fail_at'(B) :- '$sys_var_read'(7, Handler), % for debug % write(catch_sync(Handler, B)), nl, ( Handler > B -> throw('$catch_sync'(B)) ; '$catch_fail_now'(Handler) ). '$catch_fail_now'(B) :- '$set_current_B'(B), fail. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/arith_inl_c.c��������������������������������������������������������������0000644�0001750�0001750�00000061532�13021324543�015725� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : arith_inl_c.c * * Descr.: arithmetic (inline) management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <string.h> #include <math.h> #define OBJ_INIT Arith_Initializer #include "engine_pl.h" #include "bips_pl.h" #ifdef _MSC_VER #define rint(x) (floor((x) + (double) 0.5)) #endif /* PI */ #ifndef M_PI #define M_PI 3.1415926535897932384 #endif #ifndef M_E #define M_E 2.7182818284590452354 #endif /* Difference between 1.0 and the minimum double greater than 1.0 */ #ifndef DBL_EPSILON #ifdef __DBL_EPSILON__ #define DBL_EPSILON __DBL_EPSILON__ #else #define DBL_EPSILON 2.2204460492503131e-16 /* C double (64 bits IEEE encoding) */ #endif #endif /*---------------------------------* * Constants * *---------------------------------*/ #define START_ARITH_TBL_SIZE 64 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct { WamWord f_n; WamWord (FC *fct) (); } ArithInf; /*---------------------------------* * Global Variables * *---------------------------------*/ static char *arith_tbl; static int atom_pi; static int atom_e; static int atom_epsilon; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static WamWord Make_Tagged_Float(double d); static double To_Double(WamWord x); static WamWord Load_Math_Expression(WamWord exp); #define ADD_ARITH_OPER(atom_str, arity, f) \ arith_info.f_n = Functor_Arity(Pl_Create_Atom(atom_str), arity); \ arith_info.fct = f; \ Pl_Hash_Insert(arith_tbl, (char *) &arith_info, FALSE) /*-------------------------------------------------------------------------* * ARITH_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Arith_Initializer(void) { ArithInf arith_info; arith_tbl = Pl_Hash_Alloc_Table(START_ARITH_TBL_SIZE, sizeof(ArithInf)); ADD_ARITH_OPER("+", 1, Pl_Fct_Identity); ADD_ARITH_OPER("-", 1, Pl_Fct_Neg); ADD_ARITH_OPER("inc", 1, Pl_Fct_Inc); ADD_ARITH_OPER("dec", 1, Pl_Fct_Dec); ADD_ARITH_OPER("+", 2, Pl_Fct_Add); ADD_ARITH_OPER("-", 2, Pl_Fct_Sub); ADD_ARITH_OPER("*", 2, Pl_Fct_Mul); ADD_ARITH_OPER("//", 2, Pl_Fct_Div); ADD_ARITH_OPER("/", 2, Pl_Fct_Float_Div); ADD_ARITH_OPER("rem", 2, Pl_Fct_Rem); ADD_ARITH_OPER("mod", 2, Pl_Fct_Mod); ADD_ARITH_OPER("div", 2, Pl_Fct_Div2); ADD_ARITH_OPER("/\\", 2, Pl_Fct_And); ADD_ARITH_OPER("\\/", 2, Pl_Fct_Or); ADD_ARITH_OPER("xor", 2, Pl_Fct_Xor); ADD_ARITH_OPER("\\", 1, Pl_Fct_Not); ADD_ARITH_OPER("<<", 2, Pl_Fct_Shl); ADD_ARITH_OPER(">>", 2, Pl_Fct_Shr); ADD_ARITH_OPER("lsb", 1, Pl_Fct_LSB); ADD_ARITH_OPER("msb", 1, Pl_Fct_MSB); ADD_ARITH_OPER("popcount", 1, Pl_Fct_Popcount); ADD_ARITH_OPER("abs", 1, Pl_Fct_Abs); ADD_ARITH_OPER("sign", 1, Pl_Fct_Sign); ADD_ARITH_OPER("gcd", 2, Pl_Fct_GCD); ADD_ARITH_OPER("min", 2, Pl_Fct_Min); ADD_ARITH_OPER("max", 2, Pl_Fct_Max); ADD_ARITH_OPER("^", 2, Pl_Fct_Integer_Pow); ADD_ARITH_OPER("**", 2, Pl_Fct_Pow); ADD_ARITH_OPER("sqrt", 1, Pl_Fct_Sqrt); ADD_ARITH_OPER("tan", 1, Pl_Fct_Tan); ADD_ARITH_OPER("atan", 1, Pl_Fct_Atan); ADD_ARITH_OPER("atan2", 2, Pl_Fct_Atan2); ADD_ARITH_OPER("cos", 1, Pl_Fct_Cos); ADD_ARITH_OPER("acos", 1, Pl_Fct_Acos); ADD_ARITH_OPER("sin", 1, Pl_Fct_Sin); ADD_ARITH_OPER("asin", 1, Pl_Fct_Asin); ADD_ARITH_OPER("tanh", 1, Pl_Fct_Tanh); ADD_ARITH_OPER("atanh", 1, Pl_Fct_Atanh); ADD_ARITH_OPER("cosh", 1, Pl_Fct_Cosh); ADD_ARITH_OPER("acosh", 1, Pl_Fct_Acosh); ADD_ARITH_OPER("sinh", 1, Pl_Fct_Sinh); ADD_ARITH_OPER("asinh", 1, Pl_Fct_Asinh); ADD_ARITH_OPER("exp", 1, Pl_Fct_Exp); ADD_ARITH_OPER("log", 1, Pl_Fct_Log); ADD_ARITH_OPER("log10", 1, Pl_Fct_Log10); ADD_ARITH_OPER("log", 2, Pl_Fct_Log_Radix); ADD_ARITH_OPER("float", 1, Pl_Fct_Float); ADD_ARITH_OPER("ceiling", 1, Pl_Fct_Ceiling); ADD_ARITH_OPER("floor", 1, Pl_Fct_Floor); ADD_ARITH_OPER("round", 1, Pl_Fct_Round); ADD_ARITH_OPER("truncate", 1, Pl_Fct_Truncate); ADD_ARITH_OPER("float_fractional_part", 1, Pl_Fct_Float_Fract_Part); ADD_ARITH_OPER("float_integer_part", 1, Pl_Fct_Float_Integ_Part); atom_pi = Pl_Create_Atom("pi"); atom_e = Pl_Create_Atom("e"); atom_epsilon = Pl_Create_Atom("epsilon"); } /*-------------------------------------------------------------------------* * PL_DEFINE_MATH_BIP_2 * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void Pl_Define_Math_Bip_2(WamWord func_word, WamWord arity_word) { char *cur_bip_func; int cur_bip_arity; cur_bip_func = Pl_Rd_String_Check(func_word); cur_bip_arity = Pl_Rd_Integer_Check(arity_word); Pl_Set_C_Bip_Name(cur_bip_func, cur_bip_arity); } /*-------------------------------------------------------------------------* * PL_MATH_LOAD_VALUE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Math_Load_Value(WamWord start_word, WamWord *word_adr) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); if (tag_mask != TAG_INT_MASK && tag_mask != TAG_FLT_MASK) word = Load_Math_Expression(word); *word_adr = word; } /*-------------------------------------------------------------------------* * PL_MATH_FAST_LOAD_VALUE * * * * Called by compiled prolog code. * *-------------------------------------------------------------------------*/ void FC Pl_Math_Fast_Load_Value(WamWord start_word, WamWord *word_adr) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); *word_adr = word; } /*-------------------------------------------------------------------------* * MAKE_TAGGED_FLOAT * * * *-------------------------------------------------------------------------*/ static WamWord Make_Tagged_Float(double d) { WamWord x = Tag_FLT(H); Pl_Global_Push_Float(d); return x; } /*-------------------------------------------------------------------------* * TO_DOUBLE * * * *-------------------------------------------------------------------------*/ static double To_Double(WamWord x) { return (Tag_Is_INT(x)) ? (double) (UnTag_INT(x)) : Pl_Obtain_Float(UnTag_FLT(x)); } /*-------------------------------------------------------------------------* * LOAD_MATH_EXPRESSION * * * *-------------------------------------------------------------------------*/ static WamWord Load_Math_Expression(WamWord exp) { WamWord word, tag_mask; WamWord *adr; WamWord *lst_adr; ArithInf *arith; int atom; DEREF(exp, word, tag_mask); if (tag_mask == TAG_INT_MASK || tag_mask == TAG_FLT_MASK) return word; if (tag_mask == TAG_LST_MASK) { lst_adr = UnTag_LST(word); DEREF(Cdr(lst_adr), word, tag_mask); if (word != NIL_WORD) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(ATOM_CHAR('.')); Pl_Unify_Integer(2); Pl_Err_Type(pl_type_evaluable, word); } DEREF(Car(lst_adr), word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_INT_MASK) { Pl_Err_Type(pl_type_integer, word); } return word; } if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); arith = (ArithInf *) Pl_Hash_Find(arith_tbl, Functor_And_Arity(adr)); if (arith == NULL) { word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Atom(Functor(adr)); Pl_Unify_Integer(Arity(adr)); Pl_Err_Type(pl_type_evaluable, word); } if (Arity(adr) == 1) return (*(arith->fct)) (Load_Math_Expression(Arg(adr, 0))); return (*(arith->fct)) (Load_Math_Expression(Arg(adr, 0)), Load_Math_Expression(Arg(adr, 1))); } if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask == TAG_ATM_MASK) { atom = UnTag_ATM(word); if (atom == atom_pi) return Pl_Fct_PI(); if (atom == atom_e) return Pl_Fct_E(); if (atom == atom_epsilon) return Pl_Fct_Epsilon(); word = Pl_Put_Structure(ATOM_CHAR('/'), 2); Pl_Unify_Value(exp); Pl_Unify_Integer(0); /* then type_error */ } Pl_Err_Type(pl_type_evaluable, word); return word; } /*-------------------------------------------------------------------------* * PL_ARITH_EVAL_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Arith_Eval_2(WamWord exp_word, WamWord x_word) { return Pl_Unify(Load_Math_Expression(exp_word), x_word); } /*-------------------------------------------------------------------------* * PL_SUCC_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Succ_2(WamWord x_word, WamWord y_word) { WamWord word, tag_mask; PlLong x; DEREF(x_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Un_Positive_Check(Pl_Rd_Positive_Check(word) + 1, y_word); Pl_Check_For_Un_Positive(word); x = Pl_Rd_Positive_Check(y_word) - 1; return x >= 0 && Pl_Get_Integer(x, word); } /* Mathematic Operations */ #define C_Neg(x) (- (x)) #define C_Add(x, y) ((x) + (y)) #define C_Sub(x, y) ((x) - (y)) #define C_Mul(x, y) ((x) * (y)) #define C_Div(x, y) ((y) != 0 ? (x) / (y) : (Pl_Err_Evaluation(pl_evluation_zero_divisor), 0)) #define Identity(x) (x) #define DInc(x) ((x) + 1) #define DDec(x) ((x) - 1) #define DSign(x) ((x) < 0.0 ? -1.0 : (x) > 0.0 ? 1.0 : 0.0) #define DInteg(x) (((x) > 0) ? floor(x) : ceil(x)) #define DFract(x) ((x) - DInteg(x)) #define Log_Radix(b, x) (log(x) / log(b)) #define X_and_Y_are_INT(x, y) Tag_Is_INT(x & y) #define IFxIFtoIF(x, y, c_op, fast_op) \ return (X_and_Y_are_INT(x, y)) \ ? fast_op(x, y) \ : Make_Tagged_Float(c_op(To_Double(x), To_Double(y))) #define IFxIFtoF(x, y, c_op) \ return Make_Tagged_Float(c_op(To_Double(x), To_Double(y))) #define IxItoI(x, y, fast_op) \ if (Tag_Is_FLT(x)) /* error case */ \ Pl_Err_Type(pl_type_integer, x); \ if (Tag_Is_FLT(y)) /* error case */ \ Pl_Err_Type(pl_type_integer, y); \ return fast_op(x, y) #define IFtoIF(x, c_op, fast_op) \ return (Tag_Is_INT(x)) ? fast_op(x) : \ Make_Tagged_Float(c_op(To_Double(x))) #define ItoI(x, fast_op) \ if (Tag_Is_FLT(x)) /* error case */ \ Pl_Err_Type(pl_type_integer, x); \ return fast_op(x) #define IFtoF(x, c_op) \ return Make_Tagged_Float(c_op(To_Double(x))) /* FtoI is ONLY used for rounding functions */ #define FtoI(x, c_op) \ double d; \ if (Tag_Is_INT(x)) /* error case */ \ { \ if (Flag_Value(strict_iso)) \ Pl_Err_Type(pl_type_float, x); \ \ return x; \ } \ else \ d = Pl_Obtain_Float(UnTag_FLT(x)); \ return Tag_INT((PlLong) c_op(d)) #define FtoF(x, c_op) \ double d; \ if (Tag_Is_INT(x)) /* error case */ \ { \ Pl_Err_Type(pl_type_float, x); \ \ return x; /* for clang (avoid d uninit) */ \ } \ else \ d = Pl_Obtain_Float(UnTag_FLT(x)); \ return Make_Tagged_Float(c_op(d)) /* fast-math version */ WamWord FC Pl_Fct_Fast_Neg(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT(-vx); } WamWord FC Pl_Fct_Fast_Inc(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT(vx + 1); } WamWord FC Pl_Fct_Fast_Dec(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT(vx - 1); } WamWord FC Pl_Fct_Fast_Add(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return Tag_INT(vx + vy); } WamWord FC Pl_Fct_Fast_Sub(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return Tag_INT(vx - vy); } WamWord FC Pl_Fct_Fast_Mul(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return Tag_INT(vx * vy); } WamWord FC Pl_Fct_Fast_Div(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); if (vy == 0) Pl_Err_Evaluation(pl_evluation_zero_divisor); return Tag_INT(vx / vy); } WamWord FC Pl_Fct_Fast_Rem(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); if (vy == 0) Pl_Err_Evaluation(pl_evluation_zero_divisor); return Tag_INT(vx % vy); } WamWord FC Pl_Fct_Fast_Mod(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); PlLong m; if (vy == 0) Pl_Err_Evaluation(pl_evluation_zero_divisor); m = vx % vy; if (m != 0 && (m ^ vy) < 0) /* have m and vy different signs ? */ m += vy; return Tag_INT(m); } WamWord FC Pl_Fct_Fast_Div2(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); PlLong m; if (vy == 0) Pl_Err_Evaluation(pl_evluation_zero_divisor); m = vx % vy; if (m != 0 && (m ^ vy) < 0) /* have m and vy different signs ? */ m += vy; m = (vx - m) / vy; return Tag_INT(m); } WamWord FC Pl_Fct_Fast_And(WamWord x, WamWord y) { return x & y; } WamWord FC Pl_Fct_Fast_Or(WamWord x, WamWord y) { return x | y; } WamWord FC Pl_Fct_Fast_Xor(WamWord x, WamWord y) { return (x ^ y) | TAG_INT_MASK; } WamWord FC Pl_Fct_Fast_Not(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT(~vx); } WamWord FC Pl_Fct_Fast_Shl(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return Tag_INT(vx << vy); } WamWord FC Pl_Fct_Fast_Shr(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return Tag_INT(vx >> vy); } WamWord FC Pl_Fct_Fast_LSB(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT((vx == 0) ? -1 : Pl_Least_Significant_Bit(vx)); } WamWord FC Pl_Fct_Fast_MSB(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT((vx == 0) ? -1 : Pl_Most_Significant_Bit(vx)); } WamWord FC Pl_Fct_Fast_Popcount(WamWord x) { PlLong vx = UnTag_INT(x); return Tag_INT(Pl_Count_Set_Bits(vx)); } WamWord FC Pl_Fct_Fast_Abs(WamWord x) { PlLong vx = UnTag_INT(x); return (vx < 0) ? Tag_INT(-vx) : x; } WamWord FC Pl_Fct_Fast_Sign(WamWord x) { PlLong vx = UnTag_INT(x); return (vx < 0) ? Tag_INT(-1) : (vx == 0) ? Tag_INT(0) : Tag_INT(1); } WamWord FC Pl_Fct_Fast_GCD(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); if (vx < 0) vx = -vx; if (vy < 0) vy = -vy; while(vy != 0) { PlLong r = vx % vy; vx = vy; vy = r; } return Tag_INT(vx); } WamWord FC Pl_Fct_Fast_Integer_Pow(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); PlLong p = (PlLong) pow(vx, vy); return Tag_INT(p); } /* standard version */ WamWord FC Pl_Fct_Neg(WamWord x) { IFtoIF(x, C_Neg, Pl_Fct_Fast_Neg); } WamWord FC Pl_Fct_Inc(WamWord x) { IFtoIF(x, DInc, Pl_Fct_Fast_Inc); } WamWord FC Pl_Fct_Dec(WamWord x) { IFtoIF(x, DDec, Pl_Fct_Fast_Dec); } WamWord FC Pl_Fct_Add(WamWord x, WamWord y) { IFxIFtoIF(x, y, C_Add, Pl_Fct_Fast_Add); } WamWord FC Pl_Fct_Sub(WamWord x, WamWord y) { IFxIFtoIF(x, y, C_Sub, Pl_Fct_Fast_Sub); } WamWord FC Pl_Fct_Mul(WamWord x, WamWord y) { IFxIFtoIF(x, y, C_Mul, Pl_Fct_Fast_Mul); } WamWord FC Pl_Fct_Div(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Div); } WamWord FC Pl_Fct_Float_Div(WamWord x, WamWord y) { IFxIFtoF(x, y, C_Div); } WamWord FC Pl_Fct_Rem(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Rem); } WamWord FC Pl_Fct_Mod(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Mod); } WamWord FC Pl_Fct_Div2(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Div2); } WamWord FC Pl_Fct_And(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_And); } WamWord FC Pl_Fct_Or(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Or); } WamWord FC Pl_Fct_Xor(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Xor); } WamWord FC Pl_Fct_Not(WamWord x) { ItoI(x, Pl_Fct_Fast_Not); } WamWord FC Pl_Fct_Shl(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Shl); } WamWord FC Pl_Fct_Shr(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_Shr); } WamWord FC Pl_Fct_LSB(WamWord x) { ItoI(x, Pl_Fct_Fast_LSB); } WamWord FC Pl_Fct_MSB(WamWord x) { ItoI(x, Pl_Fct_Fast_MSB); } WamWord FC Pl_Fct_Popcount(WamWord x) { ItoI(x, Pl_Fct_Fast_Popcount); } WamWord FC Pl_Fct_Abs(WamWord x) { IFtoIF(x, fabs, Pl_Fct_Fast_Abs); } WamWord FC Pl_Fct_Sign(WamWord x) { IFtoIF(x, DSign, Pl_Fct_Fast_Sign); } WamWord FC Pl_Fct_GCD(WamWord x, WamWord y) { IxItoI(x, y, Pl_Fct_Fast_GCD); } WamWord FC Pl_Fct_Min(WamWord x, WamWord y) { double dx = To_Double(x); double dy = To_Double(y); if (dx < dy) return x; if (dx > dy) return y; return Tag_Is_INT(x) ? x : y; } WamWord FC Pl_Fct_Max(WamWord x, WamWord y) { double dx = To_Double(x); double dy = To_Double(y); if (dx > dy) return x; if (dx < dy) return y; return Tag_Is_INT(x) ? x : y; } WamWord FC Pl_Fct_Integer_Pow(WamWord x, WamWord y) { IFxIFtoIF(x, y, pow, Pl_Fct_Fast_Integer_Pow); } WamWord FC Pl_Fct_Pow(WamWord x, WamWord y) { IFxIFtoF(x, y, pow); } WamWord FC Pl_Fct_Sqrt(WamWord x) { IFtoF(x, sqrt); } WamWord FC Pl_Fct_Tan(WamWord x) { IFtoF(x, tan); } WamWord FC Pl_Fct_Atan(WamWord x) { IFtoF(x, atan); } WamWord FC Pl_Fct_Atan2(WamWord x, WamWord y) { IFxIFtoF(x, y, atan2); } WamWord FC Pl_Fct_Cos(WamWord x) { IFtoF(x, cos); } WamWord FC Pl_Fct_Acos(WamWord x) { IFtoF(x, acos); } WamWord FC Pl_Fct_Sin(WamWord x) { IFtoF(x, sin); } WamWord FC Pl_Fct_Asin(WamWord x) { IFtoF(x, asin); } WamWord FC Pl_Fct_Tanh(WamWord x) { IFtoF(x, tanh); } WamWord FC Pl_Fct_Atanh(WamWord x) { #ifdef HAVE_ATANH IFtoF(x, atanh); #else Pl_Err_Resource(Pl_Create_Atom("unavailable function")); return 0; /* anything for the compiler */ #endif } WamWord FC Pl_Fct_Cosh(WamWord x) { IFtoF(x, cosh); } WamWord FC Pl_Fct_Acosh(WamWord x) { #ifdef HAVE_ACOSH IFtoF(x, acosh); #else Pl_Err_Resource(Pl_Create_Atom("unavailable function")); return 0; /* anything for the compiler */ #endif } WamWord FC Pl_Fct_Sinh(WamWord x) { IFtoF(x, sinh); } WamWord FC Pl_Fct_Asinh(WamWord x) { #ifdef HAVE_ASINH IFtoF(x, asinh); #else Pl_Err_Resource(Pl_Create_Atom("unavailable function")); return 0; /* anything for the compiler */ #endif } WamWord FC Pl_Fct_Exp(WamWord x) { IFtoF(x, exp); } WamWord FC Pl_Fct_Log(WamWord x) { IFtoF(x, log); } WamWord FC Pl_Fct_Log10(WamWord x) { IFtoF(x, log10); } WamWord FC Pl_Fct_Log_Radix(WamWord b, WamWord x) { IFxIFtoF(b, x, Log_Radix); } WamWord FC Pl_Fct_Float(WamWord x) { IFtoF(x, Identity); } WamWord FC Pl_Fct_Ceiling(WamWord x) { FtoI(x, ceil); } WamWord FC Pl_Fct_Floor(WamWord x) { FtoI(x, floor); } WamWord FC Pl_Fct_Round(WamWord x) { FtoI(x, rint); } WamWord FC Pl_Fct_Truncate(WamWord x) { FtoI(x, Identity); } WamWord FC Pl_Fct_Float_Fract_Part(WamWord x) { FtoF(x, DFract); } WamWord FC Pl_Fct_Float_Integ_Part(WamWord x) { FtoF(x, DInteg); } WamWord FC Pl_Fct_PI(void) { return Make_Tagged_Float(M_PI); } WamWord FC Pl_Fct_E(void) { return Make_Tagged_Float(M_E); } WamWord FC Pl_Fct_Epsilon(void) { return Make_Tagged_Float(DBL_EPSILON); } WamWord FC Pl_Fct_Identity(WamWord x) { return x; } /* for meta-call */ /* Mathematic Comparisons */ #define Cmp_IFxIF(x, y, c_op, fast_op) \ return (X_and_Y_are_INT(x, y)) \ ? fast_op(x, y) \ : (To_Double(x) c_op To_Double(y)) /* fast-math version */ Bool FC Pl_Blt_Fast_Eq(WamWord x, WamWord y) { return x == y; } Bool FC Pl_Blt_Fast_Neq(WamWord x, WamWord y) { return x != y; } Bool FC Pl_Blt_Fast_Lt(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return vx < vy; } Bool FC Pl_Blt_Fast_Lte(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return vx <= vy; } Bool FC Pl_Blt_Fast_Gt(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return vx > vy; } Bool FC Pl_Blt_Fast_Gte(WamWord x, WamWord y) { PlLong vx = UnTag_INT(x); PlLong vy = UnTag_INT(y); return vx >= vy; } /* standard version */ Bool FC Pl_Blt_Eq(WamWord x, WamWord y) { Cmp_IFxIF(x, y, ==, Pl_Blt_Fast_Eq); } Bool FC Pl_Blt_Neq(WamWord x, WamWord y) { Cmp_IFxIF(x, y, !=, Pl_Blt_Fast_Neq); } Bool FC Pl_Blt_Lt(WamWord x, WamWord y) { Cmp_IFxIF(x, y, <, Pl_Blt_Fast_Lt); } Bool FC Pl_Blt_Lte(WamWord x, WamWord y) { Cmp_IFxIF(x, y, <=, Pl_Blt_Fast_Lte); } Bool FC Pl_Blt_Gt(WamWord x, WamWord y) { Cmp_IFxIF(x, y, >, Pl_Blt_Fast_Gt); } Bool FC Pl_Blt_Gte(WamWord x, WamWord y) { Cmp_IFxIF(x, y, >=, Pl_Blt_Fast_Gte); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/expand.pl������������������������������������������������������������������0000644�0001750�0001750�00000007656�13021324543�015131� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : expand.pl * * Descr.: term expansion management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_expand'. % all these must be steadfast (must work correctly if its output % variable is already instantiated to the output value) expand_term(T1, T3) :- '$expand_term1'(T1, T2), T2 = T3. '$expand_term1'(T1, T2) :- ( var(T1), T2 = T1 ; '$call_term_expansion'(T1, T2) ; set_bip_name(expand_term, 2), '$dcg_trans_rule'(T1, T2) ; T2 = T1 ), !. '$call_term_expansion'(T1, T2) :- '$current_predicate'(term_expansion / 2), call(term_expansion(T1, T2)). :- meta_predicate(phrase(2, ?)). :- meta_predicate(phrase(2, ?, ?)). phrase(DcgBody, In) :- '$phrase'(DcgBody, In, [], 2). phrase(DcgBody, In, Out) :- '$phrase'(DcgBody, In, Out, 3). '$phrase'(DcgBody, In, Out, Arity) :- set_bip_name(phrase, Arity), ( var(DcgBody) -> '$pl_err_instantiation' ; true ), % '$check_list_or_partial_list'(In), % '$check_list_or_partial_list'(Out), '$dcg_trans_body'(DcgBody, In, Out1, Body), '$call'(Body, user, phrase, Arity), % FIXME CallerModule Out = Out1. '$dcg_trans_rule'(Dcg, Clause) :- '$call_c_test'('Pl_Dcg_Trans_Rule_2'(Dcg, Clause)). '$dcg_trans_body'(DcgBody, In, Out, Body) :- '$call_c_test'('Pl_Dcg_Trans_Body_4'(DcgBody, In, Out, Body)). ����������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stream.wam�����������������������������������������������������������������0000644�0001750�0001750�00000110501�13021356407�015302� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : stream.pl file_name('/home/diaz/GP/src/BipsPl/stream.pl'). predicate(system:'$use_stream'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:current_input/1,44,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_input,1]), put_variable(y(0),1), call('$check_stream_or_var'/2), put_unsafe_value(y(0),0), deallocate, call_c('Pl_Current_Input_1',[boolean],[x(0)]), proceed]). predicate(system:current_output/1,52,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_output,1]), put_variable(y(0),1), call('$check_stream_or_var'/2), put_unsafe_value(y(0),0), deallocate, call_c('Pl_Current_Output_1',[boolean],[x(0)]), proceed]). predicate(system:'$check_stream_or_var'/2,60,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_structure('$stream'/1,0), unify_local_value(x(1)), get_variable(y(0),2), put_value(x(1),0), call('$$check_stream_or_var/2_$aux1'/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_value(x(0),1), put_atom(stream,0), execute('$pl_err_domain'/2)]). predicate(system:'$$check_stream_or_var/2_$aux1'/1,60,static,private,monofile,local,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), trust_me_else_fail, call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), proceed]). predicate(system:set_input/1,71,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_input,1]), call_c('Pl_Set_Input_1',[],[x(0)]), proceed]). predicate(system:set_output/1,78,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_output,1]), call_c('Pl_Set_Output_1',[],[x(0)]), proceed]). predicate(system:'$set_top_level_streams'/2,85,static,private,monofile,built_in,[ call_c('Pl_Set_Top_Level_Streams_2',[],[x(0),x(1)]), proceed]). predicate(system:'$set_debugger_streams'/2,91,static,private,monofile,built_in,[ call_c('Pl_Set_Debugger_Streams_2',[],[x(0),x(1)]), proceed]). predicate(system:open/3,110,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open,3]), put_nil(3), execute('$open'/4)]). predicate(system:open/4,115,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open,4]), execute('$open'/4)]). predicate(system:'$open'/4,120,static,private,monofile,built_in,[ allocate(7), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), call('$set_open_defaults'/0), put_value(y(2),0), put_variable(y(4),1), call('$get_open_stm'/2), put_atom('$open_aliases',0), put_variable(y(5),1), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), put_atom('$open_mirrors',0), put_variable(y(6),1), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), put_value(y(3),0), call('$get_open_options'/1), put_atom('$open_aliases',0), put_nil(1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom('$open_mirrors',0), put_nil(1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_value(y(4),2), call_c('Pl_Open_3',[],[x(0),x(1),x(2)]), put_value(y(5),0), put_value(y(2),1), call('$add_aliases_to_stream'/2), put_unsafe_value(y(6),0), put_value(y(2),1), deallocate, execute('$add_mirrors_to_stream'/2)]). predicate(system:'$set_open_defaults'/0,135,static,private,monofile,built_in,[ put_integer(0,0), put_integer(1,1), execute('$sys_var_write'/2)]). predicate(system:'$get_open_stm'/2,141,static,private,monofile,built_in,[ execute('$$get_open_stm/2_$aux1'/2)]). predicate(system:'$$get_open_stm/2_$aux1'/2,141,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), cut(x(2)), execute('$pl_err_uninstantiation'/1), label(1), trust_me_else_fail, get_structure('$stream'/1,0), unify_local_value(x(1)), proceed]). predicate(system:'$get_open_options'/1,150,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), put_value(y(0),0), call('$check_list'/1), put_value(y(0),0), deallocate, execute('$get_open_options1'/1)]). predicate(system:'$get_open_options1'/1,155,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call('$get_open_options2'/1), cut(y(1)), put_value(y(0),0), deallocate, execute('$get_open_options1'/1)]). predicate(system:'$get_open_options2'/1,162,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(15), switch_on_term(3,fail,fail,fail,2), label(2), switch_on_structure([(type/1,4),(reposition/1,6),(eof_action/1,8),(buffering/1,10),(alias/1,12),(mirror/1,14)]), label(3), try_me_else(5), label(4), allocate(1), get_structure(type/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_open_options2/1_$aux1'/1), label(5), retry_me_else(7), label(6), allocate(1), get_structure(reposition/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call('$$get_open_options2/1_$aux2'/1), put_integer(0,0), put_integer(2,1), deallocate, execute('$sys_var_set_bit'/2), label(7), retry_me_else(9), label(8), allocate(1), get_structure(eof_action/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call('$$get_open_options2/1_$aux3'/1), put_integer(0,0), put_integer(5,1), deallocate, execute('$sys_var_set_bit'/2), label(9), retry_me_else(11), label(10), allocate(1), get_structure(buffering/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call('$$get_open_options2/1_$aux4'/1), put_integer(0,0), put_integer(8,1), deallocate, execute('$sys_var_set_bit'/2), label(11), retry_me_else(13), label(12), get_structure(alias/1,0), unify_variable(x(0)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$$get_open_options2/1_$aux5'/1), label(13), trust_me_else_fail, label(14), allocate(2), get_structure(mirror/1,0), unify_variable(y(0)), get_variable(y(1),1), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), call('$$get_open_options2/1_$aux6'/1), cut(y(1)), put_value(y(0),0), call_c('Pl_Check_Valid_Mirror_1',[],[x(0)]), put_atom('$open_mirrors',0), put_list(2), unify_value(y(0)), unify_variable(x(1)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(2)]), put_atom('$open_mirrors',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), deallocate, proceed, label(15), trust_me_else_fail, put_value(x(0),1), put_atom(stream_option,0), execute('$pl_err_domain'/2)]). predicate(system:'$$get_open_options2/1_$aux6'/1,219,static,private,monofile,local,[ try_me_else(1), get_structure('$stream'/1,0), unify_variable(x(0)), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), proceed, label(1), trust_me_else_fail, call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), proceed]). predicate(system:'$$get_open_options2/1_$aux5'/1,211,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Test_Alias_Not_Assigned_1',[boolean],[x(0)]), cut(x(1)), put_atom('$open_aliases',2), put_list(3), unify_local_value(x(0)), unify_variable(x(1)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(3)]), put_atom('$open_aliases',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_structure(alias/1,2), unify_local_value(x(0)), put_atom(open,0), put_atom(source_sink,1), execute('$pl_err_permission'/3)]). predicate(system:'$$get_open_options2/1_$aux4'/1,197,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(none,3),(line,5),(block,7)]), label(2), try_me_else(4), label(3), allocate(0), get_atom(none,0), put_integer(0,0), put_integer(7,1), call('$sys_var_reset_bit'/2), put_integer(0,0), put_integer(6,1), deallocate, execute('$sys_var_reset_bit'/2), label(4), retry_me_else(6), label(5), allocate(0), get_atom(line,0), put_integer(0,0), put_integer(7,1), call('$sys_var_reset_bit'/2), put_integer(0,0), put_integer(6,1), deallocate, execute('$sys_var_set_bit'/2), label(6), trust_me_else_fail, label(7), allocate(0), get_atom(block,0), put_integer(0,0), put_integer(7,1), call('$sys_var_set_bit'/2), put_integer(0,0), put_integer(6,1), deallocate, execute('$sys_var_reset_bit'/2)]). predicate(system:'$$get_open_options2/1_$aux3'/1,183,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(error,3),(eof_code,5),(reset,7)]), label(2), try_me_else(4), label(3), allocate(0), get_atom(error,0), put_integer(0,0), put_integer(4,1), call('$sys_var_reset_bit'/2), put_integer(0,0), put_integer(3,1), deallocate, execute('$sys_var_reset_bit'/2), label(4), retry_me_else(6), label(5), allocate(0), get_atom(eof_code,0), put_integer(0,0), put_integer(4,1), call('$sys_var_reset_bit'/2), put_integer(0,0), put_integer(3,1), deallocate, execute('$sys_var_set_bit'/2), label(6), trust_me_else_fail, label(7), allocate(0), get_atom(reset,0), put_integer(0,0), put_integer(4,1), call('$sys_var_set_bit'/2), put_integer(0,0), put_integer(3,1), deallocate, execute('$sys_var_reset_bit'/2)]). predicate(system:'$$get_open_options2/1_$aux2'/1,174,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(1,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(1,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_open_options2/1_$aux1'/1,166,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(text,3),(binary,5)]), label(2), try_me_else(4), label(3), get_atom(text,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_set_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(binary,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_reset_bit'/2)]). predicate(system:'$add_aliases_to_stream'/2,233,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(2)), unify_variable(x(0)), call_c('Pl_Add_Stream_Alias_2',[],[x(1),x(2)]), execute('$add_aliases_to_stream'/2)]). predicate(system:'$add_mirrors_to_stream'/2,241,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(2)), unify_variable(x(0)), call_c('Pl_Add_Stream_Mirror_2',[],[x(1),x(2)]), execute('$add_mirrors_to_stream'/2)]). predicate(system:close/1,259,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close,1]), put_nil(1), execute('$close'/2)]). predicate(system:close/2,263,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close,2]), execute('$close'/2)]). predicate(system:'$close'/2,268,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_value(y(1),0), call('$get_close_options'/1), put_value(y(0),0), deallocate, call_c('Pl_Close_1',[],[x(0)]), proceed]). predicate(system:'$get_close_options'/1,276,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), put_value(y(0),0), call('$check_list'/1), put_value(y(0),0), deallocate, execute('$get_close_options1'/1)]). predicate(system:'$get_close_options1'/1,281,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call('$get_close_options2'/1), cut(y(1)), put_value(y(0),0), deallocate, execute('$get_close_options1'/1)]). predicate(system:'$get_close_options2'/1,288,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(2), allocate(1), get_structure(force/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_close_options2/1_$aux1'/1), label(2), trust_me_else_fail, put_value(x(0),1), put_atom(close_option,0), execute('$pl_err_domain'/2)]). predicate(system:'$$get_close_options2/1_$aux1'/1,292,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(false,3),(true,5)]), label(2), try_me_else(4), label(3), get_atom(false,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(true,0), put_integer(0,0), put_integer(0,1), execute('$sys_var_set_bit'/2)]). predicate(system:add_stream_alias/2,306,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[add_stream_alias,2]), call_c('Pl_Add_Stream_Alias_2',[boolean],[x(0),x(1)]), cut(x(2)), proceed, label(1), trust_me_else_fail, put_structure(alias/1,2), unify_local_value(x(1)), put_atom(add_alias,0), put_atom(source_sink,1), execute('$pl_err_permission'/3)]). predicate(system:add_stream_mirror/2,316,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[add_stream_mirror,2]), call_c('Pl_Add_Stream_Mirror_2',[],[x(0),x(1)]), proceed]). predicate(system:remove_stream_mirror/2,323,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[remove_stream_mirror,2]), call_c('Pl_Remove_Stream_Mirror_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:set_stream_type/2,330,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_stream_type,2]), put_value(y(1),0), call('$set_stream_type/2_$aux1'/1), put_value(y(1),0), put_variable(y(3),1), call('$set_stream_type/2_$aux2'/2), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), deallocate, call_c('Pl_Set_Stream_Type_2',[],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom(stream_type,0), execute('$pl_err_domain'/2)]). predicate(system:'$set_stream_type/2_$aux2'/2,330,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(text,3),(binary,5)]), label(2), try_me_else(4), label(3), get_atom(text,0), get_integer(1,1), proceed, label(4), trust_me_else_fail, label(5), get_atom(binary,0), get_integer(0,1), proceed]). predicate(system:'$set_stream_type/2_$aux1'/1,330,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, proceed]). predicate(system:set_stream_eof_action/2,349,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_stream_eof_action,2]), put_value(y(1),0), call('$set_stream_eof_action/2_$aux1'/1), put_value(y(1),0), put_variable(y(3),1), call('$set_stream_eof_action/2_$aux2'/2), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), deallocate, call_c('Pl_Set_Stream_Eof_Action_2',[],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom(eof_action,0), execute('$pl_err_domain'/2)]). predicate(system:'$set_stream_eof_action/2_$aux2'/2,349,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(error,3),(eof_code,5),(reset,7)]), label(2), try_me_else(4), label(3), get_atom(error,0), get_integer(0,1), proceed, label(4), retry_me_else(6), label(5), get_atom(eof_code,0), get_integer(1,1), proceed, label(6), trust_me_else_fail, label(7), get_atom(reset,0), get_integer(2,1), proceed]). predicate(system:'$set_stream_eof_action/2_$aux1'/1,349,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, proceed]). predicate(system:set_stream_buffering/2,370,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_stream_buffering,2]), put_value(y(1),0), call('$set_stream_buffering/2_$aux1'/1), put_value(y(1),0), put_variable(y(3),1), call('$set_stream_buffering/2_$aux2'/2), cut(y(2)), put_value(y(0),0), put_unsafe_value(y(3),1), deallocate, call_c('Pl_Set_Stream_Buffering_2',[],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom(buffering_mode,0), execute('$pl_err_domain'/2)]). predicate(system:'$set_stream_buffering/2_$aux2'/2,370,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(none,3),(line,5),(block,7)]), label(2), try_me_else(4), label(3), get_atom(none,0), get_integer(0,1), proceed, label(4), retry_me_else(6), label(5), get_atom(line,0), get_integer(1,1), proceed, label(6), trust_me_else_fail, label(7), get_atom(block,0), get_integer(2,1), proceed]). predicate(system:'$set_stream_buffering/2_$aux1'/1,370,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), trust_me_else_fail, proceed]). predicate(system:'$PB_empty_buffer'/1,391,static,private,monofile,built_in,[ call_c('Pl_PB_Empty_Buffer_1',[],[x(0)]), proceed]). predicate(system:flush_output/0,397,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[flush_output,0]), call_c('Pl_Flush_Output_0',[],[]), proceed]). predicate(system:flush_output/1,401,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[flush_output,1]), call_c('Pl_Flush_Output_1',[],[x(0)]), proceed]). predicate(system:current_stream/1,408,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_stream,1]), put_variable(y(0),1), call('$check_stream_or_var'/2), put_unsafe_value(y(0),0), deallocate, execute('$current_stream'/1)]). predicate(system:'$current_stream'/1,416,static,private,monofile,built_in,[ call_c('Pl_Current_Stream_1',[boolean],[x(0)]), proceed]). predicate(system:'$current_stream_alt'/0,420,static,private,monofile,built_in,[ call_c('Pl_Current_Stream_Alt_0',[boolean],[]), proceed]). predicate(system:stream_property/2,426,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(3), get_variable(y(0),1), get_variable(y(1),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[stream_property,2]), put_variable(y(2),1), call('$check_stream_or_var'/2), put_value(y(0),0), put_unsafe_value(y(2),1), put_unsafe_value(y(1),2), deallocate, execute('$stream_property/2_$aux1'/3)]). predicate(system:'$stream_property/2_$aux1'/3,426,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), get_structure(alias/1,0), unify_variable(x(0)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(3)), call_c('Pl_From_Alias_To_Stream_2',[boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(0),0), call('$check_stream_prop'/1), cut(y(2)), put_value(y(1),0), call('$current_stream'/1), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$stream_property1'/2)]). predicate(system:'$check_stream_prop'/1,441,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), retry_me_else(28), switch_on_term(4,2,fail,fail,3), label(2), switch_on_atom([(input,9),(output,11)]), label(3), switch_on_structure([(file_name/1,5),(mode/1,7),(alias/1,13),(mirror/1,15),(type/1,17),(reposition/1,19),(eof_action/1,21),(buffering/1,23),(end_of_stream/1,25),(position/1,27)]), label(4), try_me_else(6), label(5), get_structure(file_name/1,0), unify_void(1), proceed, label(6), retry_me_else(8), label(7), get_structure(mode/1,0), unify_void(1), proceed, label(8), retry_me_else(10), label(9), get_atom(input,0), proceed, label(10), retry_me_else(12), label(11), get_atom(output,0), proceed, label(12), retry_me_else(14), label(13), get_structure(alias/1,0), unify_void(1), proceed, label(14), retry_me_else(16), label(15), get_structure(mirror/1,0), unify_void(1), proceed, label(16), retry_me_else(18), label(17), get_structure(type/1,0), unify_void(1), proceed, label(18), retry_me_else(20), label(19), get_structure(reposition/1,0), unify_void(1), proceed, label(20), retry_me_else(22), label(21), get_structure(eof_action/1,0), unify_void(1), proceed, label(22), retry_me_else(24), label(23), get_structure(buffering/1,0), unify_void(1), proceed, label(24), retry_me_else(26), label(25), get_structure(end_of_stream/1,0), unify_void(1), proceed, label(26), trust_me_else_fail, label(27), get_structure(position/1,0), unify_void(1), proceed, label(28), trust_me_else_fail, put_value(x(0),1), put_atom(stream_property,0), execute('$pl_err_domain'/2)]). predicate(system:'$stream_property1'/2,474,static,private,monofile,built_in,[ switch_on_term(3,1,fail,fail,2), label(1), switch_on_atom([(input,8),(output,10)]), label(2), switch_on_structure([(file_name/1,4),(mode/1,6),(alias/1,12),(mirror/1,14),(type/1,16),(reposition/1,18),(eof_action/1,20),(buffering/1,22),(position/1,24),(end_of_stream/1,26)]), label(3), try_me_else(5), label(4), get_structure(file_name/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_File_Name_2',[boolean],[x(0),x(1)]), proceed, label(5), retry_me_else(7), label(6), get_structure(mode/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_Mode_2',[boolean],[x(0),x(1)]), proceed, label(7), retry_me_else(9), label(8), get_atom(input,0), call_c('Pl_Stream_Prop_Input_1',[boolean],[x(1)]), proceed, label(9), retry_me_else(11), label(10), get_atom(output,0), call_c('Pl_Stream_Prop_Output_1',[boolean],[x(1)]), proceed, label(11), retry_me_else(13), label(12), get_variable(x(2),1), get_structure(alias/1,0), unify_variable(x(1)), put_value(x(2),0), execute('$current_alias'/2), label(13), retry_me_else(15), label(14), allocate(2), get_structure(mirror/1,0), unify_variable(y(0)), put_value(x(1),0), put_variable(y(1),1), call('$current_mirror'/2), put_value(y(0),0), get_structure('$stream'/1,0), unify_local_value(y(1)), deallocate, proceed, label(15), retry_me_else(17), label(16), get_structure(type/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_Type_2',[boolean],[x(0),x(1)]), proceed, label(17), retry_me_else(19), label(18), get_structure(reposition/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_Reposition_2',[boolean],[x(0),x(1)]), proceed, label(19), retry_me_else(21), label(20), get_structure(eof_action/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_Eof_Action_2',[boolean],[x(0),x(1)]), proceed, label(21), retry_me_else(23), label(22), get_structure(buffering/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_Buffering_2',[boolean],[x(0),x(1)]), proceed, label(23), retry_me_else(25), label(24), get_variable(x(2),1), get_structure(position/1,0), unify_variable(x(1)), put_structure('$stream'/1,0), unify_local_value(x(2)), execute('$stream_position'/2), label(25), trust_me_else_fail, label(26), get_structure(end_of_stream/1,0), unify_variable(x(0)), call_c('Pl_Stream_Prop_End_Of_Stream_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:at_end_of_stream/0,515,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[at_end_of_stream,0]), call_c('Pl_At_End_Of_Stream_0',[boolean],[]), proceed]). predicate(system:at_end_of_stream/1,519,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[at_end_of_stream,1]), call_c('Pl_At_End_Of_Stream_1',[boolean],[x(0)]), proceed]). predicate(system:current_alias/2,526,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_alias,2]), put_variable(y(1),1), call('$check_stream_or_var'/2), put_value(y(0),0), put_unsafe_value(y(1),1), deallocate, execute('$current_alias/2_$aux1'/2)]). predicate(system:'$current_alias/2_$aux1'/2,526,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(2)), call_c('Pl_From_Alias_To_Stream_2',[boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_value(y(1),0), call('$current_stream'/1), put_value(y(1),0), put_value(y(0),1), deallocate, execute('$current_alias'/2)]). predicate(system:'$current_alias'/2,538,static,private,monofile,built_in,[ call_c('Pl_Current_Alias_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_alias_alt'/0,541,static,private,monofile,built_in,[ call_c('Pl_Current_Alias_Alt_0',[boolean],[]), proceed]). predicate(system:current_mirror/2,547,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_mirror,2]), put_variable(y(1),1), call('$check_stream_or_var'/2), put_value(y(0),0), put_variable(y(2),1), call('$check_stream_or_var'/2), put_value(y(1),0), call('$current_stream'/1), put_unsafe_value(y(1),0), put_unsafe_value(y(2),1), deallocate, execute('$current_mirror'/2)]). predicate(system:'$current_mirror'/2,557,static,private,monofile,built_in,[ call_c('Pl_Current_Mirror_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_mirror_alt'/0,560,static,private,monofile,built_in,[ call_c('Pl_Current_Mirror_Alt_0',[boolean],[]), proceed]). predicate(system:stream_position/2,566,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[stream_position,2]), execute('$stream_position'/2)]). predicate(system:'$stream_position'/2,571,static,private,monofile,built_in,[ call_c('Pl_Stream_Position_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:set_stream_position/2,577,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_stream_position,2]), call_c('Pl_Set_Stream_Position_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:seek/4,584,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[seek,4]), call_c('Pl_Seek_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:character_count/2,591,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[character_count,2]), call_c('Pl_Character_Count_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:line_count/2,598,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[line_count,2]), call_c('Pl_Line_Count_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:line_position/2,605,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[line_position,2]), call_c('Pl_Line_Position_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:stream_line_column/3,612,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[stream_line_column,3]), call_c('Pl_Stream_Line_Column_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:set_stream_line_column/3,619,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_stream_line_column,3]), call_c('Pl_Set_Stream_Line_Column_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:open_input_atom_stream/2,632,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open_input_atom_stream,2]), put_value(x(1),0), put_variable(y(1),1), call('$get_open_stm'/2), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_value(y(0),0), put_unsafe_value(y(1),1), deallocate, call_c('Pl_Open_Input_Term_Stream_2',[],[x(0),x(1)]), proceed]). predicate(system:open_input_chars_stream/2,641,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open_input_chars_stream,2]), put_value(x(1),0), put_variable(y(1),1), call('$get_open_stm'/2), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_value(y(0),0), put_unsafe_value(y(1),1), deallocate, call_c('Pl_Open_Input_Term_Stream_2',[],[x(0),x(1)]), proceed]). predicate(system:open_input_codes_stream/2,650,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open_input_codes_stream,2]), put_value(x(1),0), put_variable(y(1),1), call('$get_open_stm'/2), put_integer(0,0), put_integer(3,1), call('$sys_var_write'/2), put_value(y(0),0), put_unsafe_value(y(1),1), deallocate, call_c('Pl_Open_Input_Term_Stream_2',[],[x(0),x(1)]), proceed]). predicate(system:close_input_atom_stream/1,659,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close_input_atom_stream,1]), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_value(y(0),0), deallocate, call_c('Pl_Close_Input_Term_Stream_1',[],[x(0)]), proceed]). predicate(system:close_input_chars_stream/1,667,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close_input_chars_stream,1]), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_value(y(0),0), deallocate, call_c('Pl_Close_Input_Term_Stream_1',[],[x(0)]), proceed]). predicate(system:close_input_codes_stream/1,675,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close_input_codes_stream,1]), put_integer(0,0), put_integer(3,1), call('$sys_var_write'/2), put_value(y(0),0), deallocate, call_c('Pl_Close_Input_Term_Stream_1',[],[x(0)]), proceed]). predicate(system:open_output_atom_stream/1,683,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open_output_atom_stream,1]), put_variable(y(0),1), call('$get_open_stm'/2), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_unsafe_value(y(0),0), deallocate, call_c('Pl_Open_Output_Term_Stream_1',[],[x(0)]), proceed]). predicate(system:open_output_chars_stream/1,692,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open_output_chars_stream,1]), put_variable(y(0),1), call('$get_open_stm'/2), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_unsafe_value(y(0),0), deallocate, call_c('Pl_Open_Output_Term_Stream_1',[],[x(0)]), proceed]). predicate(system:open_output_codes_stream/1,701,static,private,monofile,built_in,[ allocate(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[open_output_codes_stream,1]), put_variable(y(0),1), call('$get_open_stm'/2), put_integer(0,0), put_integer(3,1), call('$sys_var_write'/2), put_unsafe_value(y(0),0), deallocate, call_c('Pl_Open_Output_Term_Stream_1',[],[x(0)]), proceed]). predicate(system:close_output_atom_stream/2,710,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close_output_atom_stream,2]), put_integer(0,0), put_integer(1,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Close_Output_Term_Stream_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:close_output_chars_stream/2,718,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close_output_chars_stream,2]), put_integer(0,0), put_integer(2,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Close_Output_Term_Stream_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:close_output_codes_stream/2,726,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[close_output_codes_stream,2]), put_integer(0,0), put_integer(3,1), call('$sys_var_write'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Close_Output_Term_Stream_2',[boolean],[x(0),x(1)]), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/dynam_supp.h���������������������������������������������������������������0000644�0001750�0001750�00000014726�13021324543�015641� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� /*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : dynam_supp.h * * Descr.: dynamic predicate support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define DYN_ALT_FCT_FOR_TEST 0 #define DYN_ALT_FCT_FOR_FAIL 1 #define DYN_ALT_FCT_FOR_JUMP 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef PlLong (*ScanFct) (); typedef PlULong DynStamp; typedef struct dynpinf *DynPInfP; typedef struct dyncinf *DynCInfP; typedef struct /* Dobly-linked chain header */ { /* ----------------------------- */ DynCInfP first; /* first clause (or NULL) */ DynCInfP last; /* last clause (or NULL) */ }D2ChHdr; typedef struct /* Dobly-linked chain cell */ { /* ----------------------------- */ DynCInfP next; /* next clause (or NULL) */ DynCInfP prev; /* previous clause (or NULL) */ }D2ChCell; typedef struct dyncinf /* Dynamic clause information */ { /* ------------------------------ */ D2ChCell seq_chain; /* sequential chain */ D2ChCell ind_chain; /* indexical chain */ DynPInfP dyn; /* associated dyn inf (back link) */ D2ChHdr *p_ind_hdr; /* back ptr to ind_chain header */ char **p_ind_htbl; /* back ptr to ind htbl (or NULL) */ int cl_no; /* clause number */ int pl_file; /* file name of its definition */ DynStamp erase_stamp; /* FFF...F if not erased or stamp */ DynCInfP next_erased_cl; /* pointer to next erased clause */ unsigned *byte_code; /* bc pointer (NULL=interpreted) */ int term_size; /* size of the term of the clause */ WamWord term_word; /* clause [Head|Body]=<LST,adr+1> */ WamWord head_word; /* adr+1 = Car = clause term Head */ WamWord body_word; /* adr+2 = Cdr = clause term Body */ } DynCInf; typedef struct /* Dynamic switch item info */ { /* ------------------------------ */ PlLong key; /* key: atm, int, f/n */ D2ChHdr ind_chain; /* indexical chain */ } DSwtInf; typedef struct dynpinf /* Dynamic predicate information */ { /* ------------------------------ */ D2ChHdr seq_chain; /* sequential chain */ D2ChHdr var_ind_chain; /* index if 1st arg=VAR (chain) */ char *atm_htbl; /* index if 1st arg=ATM (htable) */ char *int_htbl; /* index if 1st arg=INT (htable) */ D2ChHdr lst_ind_chain; /* index if 1st arg=LST (chain) */ char *stc_htbl; /* index if 1st arg=STC (htable) */ PredInf *pred; /* associated pred (back link) */ int arity; /* arity (redundant but faster) */ int count_a; /* next clause nb for asserta */ int count_z; /* next clause nb for assertz */ DynCInfP first_erased_cl; /* 1st erased clause NULL if none */ DynPInfP next_dyn_with_erase; /* next dyn with erased clauses */ } DynPInf; /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ PredInf *Pl_Create_Dynamic_Pred(int module, int func, int arity); DynCInf *Pl_Add_Dynamic_Clause(int module, WamWord head_word, WamWord body_word, Bool asserta, Bool check_perm, int pl_file); void Pl_Delete_Dynamic_Clause(DynCInf *clause); PredInf *Pl_Update_Dynamic_Pred(int module, int func, int arity, int what_to_do, int pl_file_for_multi); DynCInf *Pl_Scan_Dynamic_Pred(PredInf *pred, WamWord first_arg_word, int owner_module, int owner_func, int owner_arity, ScanFct alt_fct, int alt_fct_type, int alt_info_size, WamWord *alt_info); int Pl_Scan_Choice_Point_Pred(WamWord *b, int *func, int *arity); void Pl_Copy_Clause_To_Heap(DynCInf *clause, WamWord *head_word, WamWord *body_word); ������������������������������������������gprolog-1.4.5/src/BipsPl/consult.wam����������������������������������������������������������������0000644�0001750�0001750�00000060120�13021356407�015477� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : consult.pl file_name('/home/diaz/GP/src/BipsPl/consult.pl'). predicate(system:'$use_consult'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:'.'/2,52,static,private,monofile,built_in,[ put_list(2), unify_local_value(x(0)), unify_local_value(x(1)), put_meta_term(system,2,0), execute(consult/1)]). predicate(system:consult/1,56,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(3), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[consult,1]), put_variable(y(1),1), put_variable(y(2),2), call('$strip_module_nonvar'/3), put_value(y(2),0), call('$check_atom_or_atom_list'/1), cut(y(0)), put_unsafe_value(y(2),0), put_unsafe_value(y(1),1), deallocate, execute('$consult/1_$aux1'/2)]). predicate(system:'$consult/1_$aux1'/2,56,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), put_nil(3), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), execute('$consult2'/2), label(1), trust_me_else_fail, execute('$consult1'/2)]). predicate(system:'$consult1'/2,68,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), put_value(y(1),1), call('$consult2'/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$consult1'/2)]). predicate(system:'$consult2'/2,75,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),1), put_variable(y(1),1), put_variable(y(2),2), call('$strip_module_nonvar'/3), put_value(y(1),0), put_variable(y(3),1), put_value(y(0),2), call('$$consult2/2_$aux1'/3), put_value(y(2),1), put_variable(x(0),2), call_c('Pl_Prolog_File_Name_2',[boolean],[x(1),x(2)]), put_variable(y(4),1), call('$$consult2/2_$aux2'/2), put_atom('',0), put_atom(gplc,1), put_variable(y(5),2), call(temporary_file/3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[consult,1]), put_unsafe_value(y(5),0), put_unsafe_value(y(4),1), put_unsafe_value(y(3),2), deallocate, execute('$$consult2/2_$aux3'/3)]). predicate(system:'$$consult2/2_$aux3'/3,75,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(3), get_variable(y(0),0), get_variable(y(1),2), get_variable(y(2),3), put_value(y(0),0), call('$consult3'/2), cut(y(2)), put_value(y(0),0), put_value(y(1),1), call('$load_file'/2), put_value(y(0),0), deallocate, execute(unlink/1), label(1), trust_me_else_fail, allocate(0), call(unlink/1), put_atom(top_level_output,0), put_atom('compilation failed~n',1), put_nil(2), call(format/3), fail]). predicate(system:'$$consult2/2_$aux2'/2,75,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_atom(user,0), cut(x(2)), get_value(x(0),1), proceed, label(1), trust_me_else_fail, get_variable(x(2),1), get_variable(x(1),0), call_c('Pl_Absolute_File_Name_2',[boolean],[x(1),x(2)]), put_value(x(2),0), execute('$$consult2/2_$aux4'/2)]). predicate(system:'$$consult2/2_$aux4'/2,75,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), call(file_exists/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[consult,1]), put_atom(source_sink,0), execute('$pl_err_existence'/2)]). predicate(system:'$$consult2/2_$aux1'/3,75,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(system:'$consult3'/2,106,static,private,monofile,built_in,[ call_c('Pl_Consult_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$load_file'/2,122,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(4), get_variable(y(0),1), get_variable(y(1),2), put_atom(read,1), put_variable(y(2),2), call(open/3), call(repeat/0), put_value(y(2),0), put_variable(y(3),1), call(read/2), put_value(y(3),0), put_value(y(1),1), put_value(y(2),2), put_value(y(0),3), call('$$load_file/2_$aux1'/4), put_unsafe_value(y(2),0), deallocate, execute(close/1)]). predicate(system:'$$load_file/2_$aux1'/4,122,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), get_atom(end_of_file,0), cut(x(4)), cut(x(1)), proceed, label(1), trust_me_else_fail, allocate(0), put_value(x(2),1), put_value(x(3),2), call('$load_pred'/3), fail]). predicate(system:'$load_pred'/3,141,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,fail,fail,fail,1), label(1), switch_on_structure([(file_name/1,3),(directive/3,5),(predicate/7,7)]), label(2), try_me_else(4), label(3), get_structure(file_name/1,0), unify_variable(x(1)), put_atom('$pl_file',0), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(4), retry_me_else(6), label(5), get_variable(x(3),2), get_structure(directive/3,0), unify_variable(x(1)), unify_variable(x(2)), unify_variable(x(0)), execute('$$load_pred/3_$aux1'/4), label(6), trust_me_else_fail, label(7), allocate(12), get_variable(y(6),1), get_structure(predicate/7,0), unify_variable(x(0)), unify_variable(y(0)), unify_variable(y(1)), unify_variable(y(2)), unify_variable(y(3)), unify_variable(y(4)), unify_variable(y(5)), get_variable(y(7),3), put_value(x(2),1), put_variable(y(8),2), put_variable(y(9),3), put_variable(y(10),4), call('$load_pred_extract_module'/5), cut(y(7)), put_atom('$pl_file',0), put_variable(y(11),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(10),0), put_value(y(8),1), put_value(y(9),2), put_value(y(11),3), put_value(y(0),4), call('$check_pred_type'/5), put_value(y(3),0), put_value(y(10),1), put_value(y(8),2), put_value(y(9),3), put_value(y(11),4), put_value(y(0),5), call('$$load_pred/3_$aux2'/6), put_value(y(10),0), put_value(y(8),1), put_value(y(9),2), put_value(y(11),3), put_value(y(0),4), put_value(y(1),5), put_value(y(2),6), put_value(y(3),7), put_value(y(4),8), call('$bc_start_pred'/9), put_atom('$ctr',0), put_integer(0,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), call(repeat/0), put_atom('$ctr',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(0),1), call_c('Pl_Fct_Inc',[fast_call,x(2)],[x(1)]), put_atom('$ctr',1), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_value(y(5),1), put_value(y(6),2), put_value(y(10),3), put_value(y(11),4), call('$$load_pred/3_$aux3'/5), cut(y(7)), deallocate, proceed]). predicate(system:'$$load_pred/3_$aux3'/5,153,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_value(x(1),0), cut(x(5)), proceed, label(1), trust_me_else_fail, allocate(4), get_variable(y(0),3), get_variable(y(1),4), put_value(x(2),0), put_structure(clause/2,1), unify_variable(y(2)), unify_variable(y(3)), call(read/2), put_value(y(0),0), put_value(y(2),1), put_value(y(1),2), put_value(y(3),3), call('$add_clause_term_and_bc'/4), fail]). predicate(system:'$$load_pred/3_$aux2'/6,153,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(1), get_variable(y(0),6), get_atom(multifile,0), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_atom(multifile,3), call('$predicate_property1'/4), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), put_value(x(5),4), execute('$check_owner_files'/5)]). predicate(system:'$$load_pred/3_$aux1'/4,144,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(1), get_variable(x(5),2), get_variable(x(6),1), get_variable(y(0),4), put_structure('$load_directive_exception'/3,2), unify_variable(x(1)), unify_local_value(x(6)), unify_local_value(x(5)), put_atom(load,4), put_integer(1,5), call('$catch'/6), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_variable(x(0),2), put_atom('$pl_file',2), put_variable(x(3),4), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(4)]), put_list(2), unify_value(x(3)), unify_list, unify_local_value(x(1)), unify_list, unify_local_value(x(0)), unify_nil, put_atom(top_level_output,0), put_atom('~Nwarning: ~a:~d: ~a directive failed~n',1), execute(format/3)]). predicate(system:'$load_pred_extract_module'/5,179,static,private,monofile,built_in,[ switch_on_term(3,fail,fail,fail,1), label(1), switch_on_structure([((:)/2,2),((/)/2,8)]), label(2), try(4), trust(6), label(3), try_me_else(5), label(4), get_value(x(4),1), get_structure((:)/2,0), unify_atom(user), unify_structure((/)/2), unify_local_value(x(2)), unify_local_value(x(3)), proceed, label(5), retry_me_else(7), label(6), get_structure((:)/2,0), unify_local_value(x(4)), unify_structure((/)/2), unify_local_value(x(2)), unify_local_value(x(3)), proceed, label(7), trust_me_else_fail, label(8), get_value(x(4),1), get_structure((/)/2,0), unify_local_value(x(2)), unify_local_value(x(3)), proceed]). predicate(system:'$load_directive_exception'/3,190,static,private,monofile,built_in,[ get_variable(x(3),2), put_atom('$pl_file',2), put_variable(x(4),5), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(2),x(5)]), put_list(2), unify_value(x(4)), unify_list, unify_local_value(x(1)), unify_list, unify_local_value(x(3)), unify_list, unify_local_value(x(0)), unify_nil, put_atom(top_level_output,0), put_atom('~Nwarning: ~a:~d: ~a directive caused exception: ~q~n',1), execute(format/3)]). predicate(system:'$check_pred_type'/5,197,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), put_value(y(0),1), put_value(y(1),2), put_atom(native_code,3), call('$predicate_property1'/4), cut(y(4)), put_value(y(0),0), put_value(y(2),1), put_value(y(3),2), put_value(y(1),3), call('$$check_pred_type/5_$aux1'/4), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$$check_pred_type/5_$aux1'/4,197,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(1), get_variable(y(0),4), call('$aux_name'/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_variable(x(5),2), put_structure((/)/2,4), unify_local_value(x(0)), unify_local_value(x(3)), put_list(2), unify_local_value(x(1)), unify_list, unify_local_value(x(5)), unify_list, unify_value(x(4)), unify_nil, put_atom(top_level_output,0), put_atom('error: ~a:~d: native code procedure ~q cannot be redefined (ignored)~n',1), execute(format/3)]). predicate(system:'$check_owner_files'/5,210,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), allocate(7), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), put_value(y(0),1), put_value(y(1),2), put_variable(y(5),3), put_variable(y(6),4), call('$get_predicate_file_info'/5), put_value(y(2),0), put_unsafe_value(y(5),1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), cut(y(4)), put_value(y(0),0), put_value(y(2),1), put_value(y(3),2), put_value(y(1),3), put_unsafe_value(y(5),4), put_unsafe_value(y(6),5), deallocate, execute('$$check_owner_files/5_$aux1'/6), label(1), trust_me_else_fail, proceed]). predicate(system:'$$check_owner_files/5_$aux1'/6,210,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(1), get_variable(y(0),6), call('$aux_name'/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, allocate(2), get_variable(y(0),4), get_variable(y(1),5), get_variable(x(5),2), put_structure((/)/2,4), unify_local_value(x(0)), unify_local_value(x(3)), put_list(2), unify_local_value(x(1)), unify_list, unify_local_value(x(5)), unify_list, unify_value(x(4)), unify_nil, put_atom(top_level_output,0), put_atom('warning: ~a:~d: redefining procedure ~q~n',1), call(format/3), put_atom(top_level_output,0), put_atom(' ~a:~d: previous definition~n',1), put_list(2), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_nil, deallocate, execute(format/3)]). predicate(system:load/1,225,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(3), get_variable(y(0),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[load,1]), put_variable(y(1),1), put_variable(y(2),2), call('$strip_module_nonvar'/3), put_value(y(2),0), call('$check_atom_or_atom_list'/1), cut(y(0)), put_unsafe_value(y(2),0), put_unsafe_value(y(1),1), deallocate, execute('$load/1_$aux1'/2)]). predicate(system:'$load/1_$aux1'/2,225,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), put_nil(3), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(3)]), cut(x(2)), execute('$load2'/2), label(1), trust_me_else_fail, execute('$load1'/2)]). predicate(system:'$load1'/2,236,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), put_value(y(1),1), call('$load2'/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$load1'/2)]). predicate(system:'$load2'/2,243,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),1), put_variable(y(1),1), put_variable(y(2),2), call('$strip_module_nonvar'/3), put_value(y(1),0), put_variable(y(3),1), put_value(y(0),2), call('$$load2/2_$aux1'/3), put_value(y(2),0), put_void(1), put_void(2), put_variable(y(4),3), call(decompose_file_name/4), put_value(y(4),0), put_value(y(2),1), put_variable(y(5),2), call('$$load2/2_$aux2'/3), put_value(y(5),1), put_variable(x(0),2), call_c('Pl_Absolute_File_Name_2',[boolean],[x(1),x(2)]), put_value(y(5),1), call('$$load2/2_$aux3'/2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[load,1]), put_unsafe_value(y(5),0), put_unsafe_value(y(3),1), deallocate, execute('$load_file'/2)]). predicate(system:'$$load2/2_$aux3'/2,243,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), call(file_exists/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[load,1]), put_atom(source_sink,0), execute('$pl_err_existence'/2)]). predicate(system:'$$load2/2_$aux2'/3,243,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_atom('',0), cut(x(3)), put_value(x(1),0), put_atom('.wbc',1), execute(atom_concat/3), label(1), trust_me_else_fail, get_value(x(1),2), proceed]). predicate(system:'$$load2/2_$aux1'/3,243,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(system:'$bc_start_pred'/9,267,static,private,monofile,built_in,[ call_c('Pl_BC_Start_Pred_9',[],[x(0),x(1),x(2),x(3),x(4),x(5),x(6),x(7),x(8)]), proceed]). predicate(system:'$bc_start_emit'/0,271,static,private,monofile,built_in,[ call_c('Pl_BC_Start_Emit_0',[],[]), proceed]). predicate(system:'$bc_stop_emit'/0,274,static,private,monofile,built_in,[ call_c('Pl_BC_Stop_Emit_0',[],[]), proceed]). predicate(system:'$bc_emit'/1,277,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), call('$bc_emit_inst'/1), put_value(y(0),0), deallocate, execute('$bc_emit'/1)]). predicate(system:'$bc_emit_inst'/1,283,static,private,monofile,built_in,[ call_c('Pl_BC_Emit_Inst_1',[],[x(0)]), proceed]). predicate(system:'$bc_emulate_cont'/0,289,static,private,monofile,built_in,[ call_c('Pl_BC_Emulate_Cont_0',[jump],[]), proceed]). predicate(system:'$add_clause_term'/3,296,static,private,monofile,built_in,[ get_variable(x(3),0), put_structure((:)/2,0), unify_local_value(x(3)), unify_local_value(x(1)), put_value(x(2),3), put_integer(0,1), put_integer(0,2), execute('$assert'/4)]). predicate(system:'$add_clause_term_and_bc'/4,303,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), call('$bc_start_emit'/0), put_value(y(3),0), call('$bc_emit'/1), call('$bc_stop_emit'/0), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute('$add_clause_term'/3)]). predicate(system:listing/0,316,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[listing,0]), put_atom(user,0), put_void(1), put_void(2), execute('$listing_all'/3)]). predicate(system:listing/1,322,static,private,monofile,built_in,[ allocate(4), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[listing,1]), put_variable(y(0),1), put_variable(y(1),2), call('$strip_module_var'/3), put_value(y(1),0), put_variable(y(2),1), put_value(y(0),2), put_variable(y(3),3), call('$listing/1_$aux1'/4), put_unsafe_value(y(0),0), put_unsafe_value(y(2),1), put_unsafe_value(y(3),2), deallocate, execute('$listing_all'/3)]). predicate(system:'$listing/1_$aux1'/4,322,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(4)), get_value(x(0),1), proceed, label(1), trust_me_else_fail, get_variable(x(4),3), get_variable(x(3),1), put_value(x(2),1), put_void(2), execute('$get_pred_indic_var'/5)]). predicate(system:'$listing_all'/3,335,static,private,monofile,built_in,[ try_me_else(1), allocate(5), get_variable(y(0),0), put_atom('$last_module',0), put_value(y(0),3), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(3)]), put_structure(v/3,0), unify_variable(x(4)), unify_local_value(x(1)), unify_local_value(x(2)), put_structure('$listing_one_collect'/5,3), unify_local_value(y(0)), unify_local_value(x(1)), unify_local_value(x(2)), unify_variable(y(1)), unify_value(x(4)), put_meta_term(system,3,1), put_variable(y(2),2), call(setof/3), put_atom('$last_module',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_value(y(0),1), call('$$listing_all/3_$aux1'/2), put_atom('~n%% file: ~w~n',0), put_list(1), unify_value(y(1)), unify_nil, call(format/2), put_structure(v/3,0), unify_void(1), unify_variable(y(3)), unify_variable(y(4)), put_value(y(2),1), call(member/2), put_value(y(0),0), put_value(y(3),1), put_value(y(4),2), deallocate, execute('$listing_one_show'/3), label(1), trust_me_else_fail, proceed]). predicate(system:'$$listing_all/3_$aux1'/2,335,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), proceed, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),1), put_atom('~n:- module(~q).~n',0), put_list(1), unify_local_value(y(0)), unify_nil, call(format/2), put_atom('$last_module',0), put_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed]). predicate(system:'$listing_one_collect'/5,352,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_structure((:)/2,0), unify_local_value(y(0)), unify_structure((/)/2), unify_local_value(y(1)), unify_local_value(y(2)), put_meta_term(system,0,0), call('$current_predicate'/1), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute('$$listing_one_collect/5_$aux1'/5)]). predicate(system:'$$listing_one_collect/5_$aux1'/5,352,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), call_c('Pl_Pred_Prop_Native_Code_2',[boolean],[x(0),x(1),x(2)]), cut(x(5)), fail, label(1), trust_me_else_fail, call_c('Pl_Pred_Prop_Prolog_File_3',[boolean],[x(0),x(1),x(2),x(3)]), call_c('Pl_Pred_Prop_Prolog_Line_3',[boolean],[x(0),x(1),x(2),x(4)]), proceed]). predicate(system:'$listing_one_show'/3,385,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), put_variable(y(1),0), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), call(nl/0), put_structure((:)/2,0), unify_local_value(y(0)), unify_local_value(y(1)), put_variable(y(2),1), put_atom(false,2), call('$clause'/3), put_structure((:-)/2,0), unify_local_value(y(1)), unify_local_value(y(2)), call(portray_clause/1), fail]). directive(49,system,[ put_atom(user,0), put_structure(consult/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(50,system,[ put_atom(user,0), put_list(1), unify_atom(:), unify_atom(+), execute('$declare_meta_predicate'/2)]). directive(223,system,[ put_atom(user,0), put_structure(load/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(314,system,[ put_atom(user,0), put_structure(listing/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stat.wam�������������������������������������������������������������������0000644�0001750�0001750�00000014016�13021356407�014766� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : stat.pl file_name('/home/diaz/GP/src/BipsPl/stat.pl'). predicate(system:'$use_stat'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:statistics/0,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[statistics,0]), call_c('Pl_Statistics_0',[],[]), proceed]). predicate(system:statistics/2,49,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[statistics,2]), put_value(y(0),0), call('$check_stat_key'/1), cut(y(2)), put_value(y(1),0), put_variable(y(3),1), put_variable(y(4),2), call('$statistics/2_$aux1'/3), put_value(y(0),0), put_unsafe_value(y(3),1), put_unsafe_value(y(4),2), deallocate, execute('$stat'/3)]). predicate(system:'$statistics/2_$aux1'/3,49,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_list(0), unify_local_value(x(1)), unify_list, unify_local_value(x(2)), unify_nil, cut(x(3)), proceed, label(1), trust_me_else_fail, put_value(x(0),1), put_atom(statistics_value,0), execute('$pl_err_domain'/2)]). predicate(system:'$check_stat_key'/1,61,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed, label(1), retry_me_else(23), switch_on_term(3,2,fail,fail,fail), label(2), switch_on_atom([(user_time,4),(runtime,6),(system_time,8),(cpu_time,10),(real_time,12),(local_stack,14),(global_stack,16),(trail_stack,18),(cstr_stack,20),(atoms,22)]), label(3), try_me_else(5), label(4), get_atom(user_time,0), proceed, label(5), retry_me_else(7), label(6), get_atom(runtime,0), proceed, label(7), retry_me_else(9), label(8), get_atom(system_time,0), proceed, label(9), retry_me_else(11), label(10), get_atom(cpu_time,0), proceed, label(11), retry_me_else(13), label(12), get_atom(real_time,0), proceed, label(13), retry_me_else(15), label(14), get_atom(local_stack,0), proceed, label(15), retry_me_else(17), label(16), get_atom(global_stack,0), proceed, label(17), retry_me_else(19), label(18), get_atom(trail_stack,0), proceed, label(19), retry_me_else(21), label(20), get_atom(cstr_stack,0), proceed, label(21), trust_me_else_fail, label(22), get_atom(atoms,0), proceed, label(23), trust_me_else_fail, put_value(x(0),1), put_atom(statistics_key,0), execute('$pl_err_domain'/2)]). predicate(system:'$stat'/3,89,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_value(x(3),1), call('$$stat/3_$aux1'/2), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Statistics_User_Time_2',[boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, switch_on_term(3,2,fail,fail,fail), label(2), switch_on_atom([(system_time,4),(cpu_time,6),(real_time,8),(local_stack,10),(global_stack,12),(trail_stack,14),(cstr_stack,16),(atoms,18)]), label(3), try_me_else(5), label(4), get_atom(system_time,0), call_c('Pl_Statistics_System_Time_2',[boolean],[x(1),x(2)]), proceed, label(5), retry_me_else(7), label(6), get_atom(cpu_time,0), call_c('Pl_Statistics_Cpu_Time_2',[boolean],[x(1),x(2)]), proceed, label(7), retry_me_else(9), label(8), get_atom(real_time,0), call_c('Pl_Statistics_Real_Time_2',[boolean],[x(1),x(2)]), proceed, label(9), retry_me_else(11), label(10), get_atom(local_stack,0), call_c('Pl_Statistics_Local_Stack_2',[boolean],[x(1),x(2)]), proceed, label(11), retry_me_else(13), label(12), get_atom(global_stack,0), call_c('Pl_Statistics_Global_Stack_2',[boolean],[x(1),x(2)]), proceed, label(13), retry_me_else(15), label(14), get_atom(trail_stack,0), call_c('Pl_Statistics_Trail_Stack_2',[boolean],[x(1),x(2)]), proceed, label(15), retry_me_else(17), label(16), get_atom(cstr_stack,0), call_c('Pl_Statistics_Cstr_Stack_2',[boolean],[x(1),x(2)]), proceed, label(17), trust_me_else_fail, label(18), get_atom(atoms,0), call_c('Pl_Statistics_Atoms_2',[boolean],[x(1),x(2)]), proceed]). predicate(system:'$$stat/3_$aux1'/2,89,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),1), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(2)), call('$$stat/3_$aux2'/1), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_atom(user_time,0), proceed]). predicate(system:'$$stat/3_$aux2'/1,89,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(user_time,3),(runtime,5)]), label(2), try_me_else(4), label(3), get_atom(user_time,0), proceed, label(4), trust_me_else_fail, label(5), get_atom(runtime,0), proceed]). predicate(system:user_time/1,125,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[user_time,1]), call_c('Pl_User_Time_1',[boolean],[x(0)]), proceed]). predicate(system:system_time/1,132,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[system_time,1]), call_c('Pl_System_Time_1',[boolean],[x(0)]), proceed]). predicate(system:cpu_time/1,139,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[cpu_time,1]), call_c('Pl_Cpu_Time_1',[boolean],[x(0)]), proceed]). predicate(system:real_time/1,146,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[real_time,1]), call_c('Pl_Real_Time_1',[boolean],[x(0)]), proceed]). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/all_solut_c.c��������������������������������������������������������������0000644�0001750�0001750�00000050320�13021324543�015743� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : all_solut_c.c * * Descr.: all solution collector management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <sys/types.h> #define OBJ_INIT All_Solut_Initializer #include "engine_pl.h" #include "bips_pl.h" #ifndef _WIN32 #include <unistd.h> #include <sys/wait.h> #endif /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef struct onesol *OneSolP; typedef struct onesol { OneSolP prev; int sol_no; int term_size; WamWord term_word; } OneSol; /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord exist_2; static WamWord new_gen_word; static PlLong *bound_var_ptr; static WamWord *free_var_base; static OneSol dummy = { NULL, 0, 0 }; static OneSol *sol = &dummy; static PlLong *key_var_ptr; static PlLong *save_key_var_ptr; static PlLong *next_key_var_ptr; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Bound_Var(WamWord *adr); static WamWord Existential_Variables(WamWord start_word); static Bool Free_Var(WamWord *adr); static void Handle_Key_Variables(WamWord start_word); static Bool Link_Key_Var(WamWord *adr); static WamWord Group(WamWord all_sol_word, WamWord gl_key_word, WamWord *key_adr); #define GROUP_SOLUTIONS_ALT X1_2467726F75705F736F6C7574696F6E735F616C74 Prolog_Prototype(GROUP_SOLUTIONS_ALT, 0); /*-------------------------------------------------------------------------* * ALL_SOLUT_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void All_Solut_Initializer(void) { exist_2 = Functor_Arity(ATOM_CHAR('^'), 2); } /*-------------------------------------------------------------------------* * This part collects all free variables, i.e. variables appearing in the * * generator but neither in the template nor in the set of existentially * * qualified variables. * * - collect variables of the template (bound variables) * * - collect existentially qualified variables of the generator * * btw: compute the existentially unqualified generator * * - make in the heap the array of free variables of the unqualified * * generator * * - create a Prolog term (gl_key) with the free variables. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_FREE_VARIABLES_4 * * * * Fail if no free variables. * *-------------------------------------------------------------------------*/ Bool Pl_Free_Variables_4(WamWord templ_word, WamWord gen_word, WamWord gen1_word, WamWord key_word) { WamWord gl_key_word; WamWord *save_H, *arg; int nb_free_var = 0; bound_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores bound vars */ Pl_Treat_Vars_Of_Term(templ_word, TRUE, Bound_Var); new_gen_word = Existential_Variables(gen_word); save_H = H++; /* one more word for f/n is possible */ arg = free_var_base = H; /* array is in the heap */ Pl_Treat_Vars_Of_Term(new_gen_word, TRUE, Free_Var); nb_free_var = H - arg; if (nb_free_var == 0) return FALSE; if (nb_free_var <= MAX_ARITY) { *save_H = Functor_Arity(ATOM_CHAR('.'), nb_free_var); gl_key_word = Tag_STC(save_H); } else { H = free_var_base; gl_key_word = Pl_Mk_Proper_List(nb_free_var, arg); } Pl_Unify(new_gen_word, gen1_word); return Pl_Unify(gl_key_word, key_word); } /*-------------------------------------------------------------------------* * PL_RECOVER_GENERATOR_1 * * * *-------------------------------------------------------------------------*/ void Pl_Recover_Generator_1(WamWord gen1_word) { Pl_Unify(new_gen_word, gen1_word); } /*-------------------------------------------------------------------------* * BOUND_VAR * * * *-------------------------------------------------------------------------*/ static Bool Bound_Var(WamWord *adr) { PlLong *p; for (p = pl_glob_dico_var; p < bound_var_ptr; p++) if (*p == (PlLong) adr) return TRUE; if (bound_var_ptr - pl_glob_dico_var >= MAX_VAR_IN_TERM) Pl_Err_Representation(pl_representation_too_many_variables); *bound_var_ptr++ = (PlLong) adr; return TRUE; } /*-------------------------------------------------------------------------* * EXISTENTIAL_VARIABLES * * * *-------------------------------------------------------------------------*/ static WamWord Existential_Variables(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); if (Functor_And_Arity(adr) == exist_2) { Pl_Treat_Vars_Of_Term(Arg(adr, 0), TRUE, Bound_Var); word = Existential_Variables(Arg(adr, 1)); } } return word; } /*-------------------------------------------------------------------------* * FREE_VAR * * * *-------------------------------------------------------------------------*/ static Bool Free_Var(WamWord *adr) { PlLong *p; WamWord word; for (p = pl_glob_dico_var; p < bound_var_ptr; p++) if (*p == (PlLong) adr) return TRUE; word = Tag_REF(adr); /* if an FDV for a Dont_Separate_Tag */ for (p = free_var_base; p < H; p++) if (*p == word) return TRUE; *H++ = word; return TRUE; } /*-------------------------------------------------------------------------* * This part saves and restores all solutions found. A stack of solutions * * is used (each solution is copied to a Mallocated memory area). To handle* * nested findall and al, each solution receive a sequential number. At the* * start, the number of the solution on the top of the stack serves as a * * stop mark. * * * * Recovering the solutions: a space for the list of (nb_sol) solutions is * * reserved on the top of the heap (nb_sol*2 WamWords) then each term is * * poped from the stack and copied to the heap (the list of solutions is * * constructed from last to first (since we handle a stack). * * * * There is a special treatment for bagof/3. Each solution is a term of * * the form Key-Value. In order to group solutions by Key we use a keysort * * (done in Prolog) + Pl_Group_Solutions_3 (done in C). However, keysort/2 * * tests a term equality (==) while a structural equality is needed. * * * * Structural equality: T1 and T2 are structurally equal if their tree * * representation is equivalent (we say that T1 and T2 are variant). Namely* * there is a a bijection f from the variable of T1 to the variables of T2 * * such that T2 == f(T1). * * For instance f(A,g(B),A) is a variant of f(C,g(D),C) but f(A,B) is not a* * variant of f(C,D). * * * * Since we use keysort we have to first transform two keys K1 and K2 that * * are variants to a same term K. This can be done by unifying (linking) * * each (unbound) variable of K1 with a unique term, similarly for K2. * * The unique term used is a free variable (in fact a variable of K1). * * The function Handle_Key_Variables performs that. A set of used variables* * is maintained (a stack). Treatment of a key: * * * * - save_key_var_ptr=key_var_ptr (save current top of stack) * * - next_key_var_ptr=base of the stack * * - for each variable V of Key: * * - if V is in the stack do nothing * * - if next_key_var_ptr<save_key_var_ptr (can reuse a variable) * * then Pl_Unify(V,*next_key_var_ptr++) * * - otherwise push V (*key_var_ptr++=V) * * * * E.g. the keys [A,B,A], [f(C),D,E,F], [G,H,G] and [f(C),D,E,F] become: * * [X1,X2,X1], [f(X1),X2,X3,X4], [X1,X2,X1] and [f(X1),X2,X3,X4] * * The fact that a same variable (e.g. X1) appears in 2 keys that are not * * variants is not a problem since they will not be unified at the same * * moment. Indeed, they corresponds to 2 different group of solutions which* * are not yielded in the same calculus (a backtracking will occurs between* * each solution, c.f. Group_Solutions_3). * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_STOP_MARK_1 * * * *-------------------------------------------------------------------------*/ void Pl_Stop_Mark_1(WamWord stop_word) { Pl_Get_Integer(sol->sol_no, stop_word); } /*-------------------------------------------------------------------------* * PL_STORE_SOLUTION_1 * * * *-------------------------------------------------------------------------*/ void Pl_Store_Solution_1(WamWord term_word) { OneSol *s; int size; /* fix_bug is because when gcc sees &xxx where xxx is a fct argument variable * it allocates a frame even with -fomit-frame-pointer. * This corrupts ebp on ix86 */ static WamWord fix_bug; size = Pl_Term_Size(term_word); s = (OneSol *) Malloc(sizeof(OneSol) - sizeof(WamWord) + size * sizeof(WamWord)); s->prev = sol; s->sol_no = sol->sol_no + 1; s->term_size = size; fix_bug = term_word; Pl_Copy_Term(&s->term_word, &fix_bug); sol = s; } /*-------------------------------------------------------------------------* * PL_RECOVER_SOLUTIONS_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Recover_Solutions_4(WamWord stop_word, WamWord handle_key_word, WamWord list_word, WamWord tail_word) { int stop; int nb_sol; WamWord *p, *q; OneSol *s; Bool handle_key; stop = Pl_Rd_Integer(stop_word); nb_sol = sol->sol_no - stop; if (nb_sol == 0) return Pl_Unify(list_word, tail_word); handle_key = Pl_Rd_Integer(handle_key_word); key_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: key vars */ H += 2 * nb_sol; /* Since we start from the end to the beginning, if nb_sol is very big * when the heap overflow triggers a SIGSEGV the handler will not detect * that the heap is the culprit (and emits a simple Segmentation Violation * message). To avoid this we remain just after the end of the stack. */ if (H > Global_Stack + Global_Size) H = Global_Stack + Global_Size; p = q = H; while (nb_sol--) { p--; *p = Tag_LST(p + 1); *--p = Tag_REF(H); Pl_Copy_Contiguous_Term(H, &sol->term_word); if (handle_key) Handle_Key_Variables(*H); H += sol->term_size; s = sol; sol = sol->prev; Free(s); } q[-1] = tail_word; return Pl_Unify(Tag_LST(p), list_word); } /*-------------------------------------------------------------------------* * HANDLE_KEY_VARIABLES * * * *-------------------------------------------------------------------------*/ static void Handle_Key_Variables(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; save_key_var_ptr = key_var_ptr; next_key_var_ptr = pl_glob_dico_var; DEREF(start_word, word, tag_mask); adr = UnTag_STC(word); Pl_Treat_Vars_Of_Term(Arg(adr, 0), TRUE, Link_Key_Var); } /*-------------------------------------------------------------------------* * LINK_KEY_VAR * * * *-------------------------------------------------------------------------*/ static Bool Link_Key_Var(WamWord *adr) { PlLong *p; for (p = pl_glob_dico_var; p < key_var_ptr; p++) if (*p == (PlLong) adr) return TRUE; if (next_key_var_ptr < save_key_var_ptr) { /* same as Pl_Unify(Tag_REF(adr), *next_key_var_ptr++) */ *adr = *(WamWord *) (*next_key_var_ptr); next_key_var_ptr++; return TRUE; } if (key_var_ptr - pl_glob_dico_var >= MAX_VAR_IN_TERM) Pl_Err_Representation(pl_representation_too_many_variables); *key_var_ptr++ = (PlLong) adr; return TRUE; } /*-------------------------------------------------------------------------* * This part goups the solutions according to their Key. The list of all * * solutions is keysorted (form [Key-Val,...]). This function could be * * written in Prolog but we perform an update-in-place of the list saving * * thus memory space. * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_GROUP_SOLUTIONS_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Group_Solutions_3(WamWord all_sol_word, WamWord gl_key_word, WamWord sol_word) { WamWord word, tag_mask; WamWord key_word; DEREF(all_sol_word, word, tag_mask); if (word == NIL_WORD) return FALSE; word = Group(all_sol_word, gl_key_word, &key_word); if (word != NOT_A_WAM_WORD) { A(0) = word; A(1) = gl_key_word; A(2) = sol_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0), 3); } Pl_Unify(key_word, gl_key_word); return Pl_Unify(sol_word, all_sol_word); } /*-------------------------------------------------------------------------* * PL_GROUP_SOLUTIONS_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Group_Solutions_Alt_0(void) { WamWord all_sol_word, gl_key_word, sol_word; WamWord word; WamWord key_word; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0), 0); all_sol_word = AB(B, 0); gl_key_word = AB(B, 1); sol_word = AB(B, 2); word = Group(all_sol_word, gl_key_word, &key_word); if (word == NOT_A_WAM_WORD) Delete_Last_Choice_Point(); else /* non deterministic case */ { AB(B, 0) = word; #if 0 /* the following data is unchanged */ AB(B, 1) = gl_key_word; AB(B, 2) = sol_word; #endif } Pl_Unify(key_word, gl_key_word); return Pl_Unify(sol_word, all_sol_word); } /*-------------------------------------------------------------------------* * GROUP * * * *-------------------------------------------------------------------------*/ static WamWord Group(WamWord all_sol_word, WamWord gl_key_word, WamWord *key_adr) { WamWord word, tag_mask; WamWord *adr; WamWord *lst_adr, *prev_lst_adr; WamWord key_word, key_word1; DEREF(all_sol_word, word, tag_mask); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); /* term of the form Key-Value */ adr = UnTag_STC(word); *key_adr = key_word = Arg(adr, 0); for (;;) { /* Arg(adr,1) cannot be a Dont_Separate_Tag */ Car(lst_adr) = Arg(adr, 1); prev_lst_adr = lst_adr; DEREF(Cdr(lst_adr), word, tag_mask); if (word == NIL_WORD) return NOT_A_WAM_WORD; prev_lst_adr = lst_adr; lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); /* term of the form Key-Value */ adr = UnTag_STC(word); key_word1 = Arg(adr, 0); if (Pl_Term_Compare(key_word, key_word1) != 0) break; } all_sol_word = Cdr(prev_lst_adr); Cdr(prev_lst_adr) = NIL_WORD; return all_sol_word; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/atom_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000067201�13021324543�014713� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : atom_c.c * * Descr.: atom manipulation management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <string.h> #include <ctype.h> #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Compute_Next_BLA(int mask, AtomInf *patom, AtomInf *psub_atom, int b, int l, int a, int *b1, int *l1, int *a1); static int Create_Malloc_Atom(char *str); static Bool String_To_Number(char *str, WamWord number_word); #define ATOM_CONCAT_ALT X1_2461746F6D5F636F6E6361745F616C74 #define SUB_ATOM_ALT X1_247375625F61746F6D5F616C74 #define CURRENT_ATOM_ALT X1_2463757272656E745F61746F6D5F616C74 Prolog_Prototype(ATOM_CONCAT_ALT, 0); Prolog_Prototype(SUB_ATOM_ALT, 0); Prolog_Prototype(CURRENT_ATOM_ALT, 0); #define MALLOC_STR(n) \ if (n<0) \ return FALSE; \ str = (char *) Malloc(n + 1) /*-------------------------------------------------------------------------* * PL_ATOM_LENGTH_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Length_2(WamWord atom_word, WamWord length_word) { int atom; atom = Pl_Rd_Atom_Check(atom_word); return Pl_Un_Positive_Check(pl_atom_tbl[atom].prop.length, length_word); } /*-------------------------------------------------------------------------* * PL_NEW_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_New_Atom_2(WamWord prefix_word, WamWord atom_word) { int atom; atom = Pl_Rd_Atom_Check(prefix_word); Pl_Check_For_Un_Variable(atom_word); return Pl_Get_Atom(Pl_Gen_New_Atom(pl_atom_tbl[atom].name), atom_word); } /*-------------------------------------------------------------------------* * PL_ATOM_CONCAT_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Concat_3(WamWord atom1_word, WamWord atom2_word, WamWord atom3_word) { WamWord word, tag_mask; int tag1, tag2, tag3; AtomInf *patom1, *patom2, *patom3; char *str; int l; DEREF(atom1_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, atom1_word); tag1 = tag_mask; atom1_word = word; DEREF(atom2_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, atom2_word); tag2 = tag_mask; atom2_word = word; DEREF(atom3_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, atom3_word); tag3 = tag_mask; atom3_word = word; if (tag3 == TAG_REF_MASK && (tag1 == TAG_REF_MASK || tag2 == TAG_REF_MASK)) Pl_Err_Instantiation(); if (tag1 == TAG_ATM_MASK) { patom1 = pl_atom_tbl + UnTag_ATM(atom1_word); if (tag2 == TAG_ATM_MASK) { patom2 = pl_atom_tbl + UnTag_ATM(atom2_word); l = patom1->prop.length + patom2->prop.length; MALLOC_STR(l); strcpy(str, patom1->name); strcpy(str + patom1->prop.length, patom2->name); return Pl_Get_Atom(Create_Malloc_Atom(str), atom3_word); } patom3 = pl_atom_tbl + UnTag_ATM(atom3_word); l = patom3->prop.length - patom1->prop.length; if (l < 0 || strncmp(patom1->name, patom3->name, patom1->prop.length) != 0) return FALSE; MALLOC_STR(l); strcpy(str, patom3->name + patom1->prop.length); return Pl_Get_Atom(Create_Malloc_Atom(str), atom2_word); } if (tag2 == TAG_ATM_MASK) /* here tag1 == REF */ { patom2 = pl_atom_tbl + UnTag_ATM(atom2_word); patom3 = pl_atom_tbl + UnTag_ATM(atom3_word); l = patom3->prop.length - patom2->prop.length; if (l < 0 || strncmp(patom2->name, patom3->name + l, patom2->prop.length) != 0) return FALSE; MALLOC_STR(l); strncpy(str, patom3->name, l); str[l] = '\0'; return Pl_Get_Atom(Create_Malloc_Atom(str), atom1_word); } /* A1 and A2 are variables: non deterministic case */ patom3 = pl_atom_tbl + UnTag_ATM(atom3_word); if (patom3->prop.length > 0) { A(0) = atom1_word; A(1) = atom2_word; A(2) = (WamWord) patom3; A(3) = (WamWord) (patom3->name + 1); Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(ATOM_CONCAT_ALT, 0), 4); } return Pl_Get_Atom(pl_atom_void, atom1_word) && Pl_Get_Atom_Tagged(atom3_word, atom2_word); } /*-------------------------------------------------------------------------* * PL_ATOM_CONCAT_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Concat_Alt_0(void) { WamWord atom1_word, atom2_word; AtomInf *patom3; char *name; char *p; char *str; int l; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(ATOM_CONCAT_ALT, 0), 0); atom1_word = AB(B, 0); atom2_word = AB(B, 1); patom3 = (AtomInf *) AB(B, 2); p = (char *) AB(B, 3); if (*p == '\0') Delete_Last_Choice_Point(); else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = atom1_word; AB(B, 1) = atom2_word; AB(B, 2) = (WamWord) patom3; #endif AB(B, 3) = (WamWord) (p + 1); } name = patom3->name; l = p - name; MALLOC_STR(l); strncpy(str, name, l + 1); str[l] = '\0'; if (!Pl_Get_Atom(Create_Malloc_Atom(str), atom1_word)) return FALSE; l = patom3->prop.length - l; MALLOC_STR(l); strcpy(str, p); return Pl_Get_Atom(Create_Malloc_Atom(str), atom2_word); } #define DEREF_LG(lg_word, lg) \ DEREF(lg_word, word, tag_mask); \ mask <<= 1; \ if (tag_mask == TAG_INT_MASK) \ { \ if ((lg = UnTag_INT(word)) < 0) \ Pl_Err_Domain(pl_domain_not_less_than_zero, word); \ mask |= 1; \ } \ else \ { \ lg = 0; \ if (tag_mask != TAG_REF_MASK) \ Pl_Err_Type(pl_type_integer, word); \ } \ lg_word = word /*-------------------------------------------------------------------------* * PL_SUB_ATOM_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sub_Atom_5(WamWord atom_word, WamWord before_word, WamWord length_word, WamWord after_word, WamWord sub_atom_word) { WamWord word, tag_mask; AtomInf *patom; AtomInf *psub_atom = NULL; /* only for the compiler */ int length; PlLong b, l, a; int b1, l1, a1; Bool nondet; int mask = 0; char *str; patom = pl_atom_tbl + Pl_Rd_Atom_Check(atom_word); length = patom->prop.length; DEREF_LG(before_word, b); DEREF_LG(length_word, l); DEREF_LG(after_word, a); DEREF(sub_atom_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, word); sub_atom_word = word; if (tag_mask == TAG_ATM_MASK) { psub_atom = pl_atom_tbl + UnTag_ATM(word); l = psub_atom->prop.length; if (!Pl_Get_Integer(l, length_word)) return FALSE; if ((mask & 5) == 5 && length != b + l + a) /* B and A fixed */ return FALSE; if (mask & 4) /* B fixed */ { a = length - b - l; return strncmp(patom->name + b, psub_atom->name, l) == 0 && Pl_Get_Integer(a, after_word); } if (mask & 1) /* A fixed */ { b = length - l - a; return strncmp(patom->name + b, psub_atom->name, l) == 0 && Pl_Get_Integer(b, before_word); } mask = 8; /* set sub_atom as fixed */ } switch (mask) /* mask <= 7, B L A (1: fixed, 0: var) */ { case 0: /* nothing fixed */ case 2: /* L fixed */ case 4: /* B fixed */ a = length - b - l; nondet = TRUE; break; case 1: /* A fixed */ l = length - b - a; nondet = TRUE; break; case 3: /* L A fixed */ b = length - l - a; nondet = FALSE; break; case 5: /* B A fixed */ l = length - b - a; nondet = FALSE; break; case 6: /* B L fixed */ case 7: /* B L A fixed */ a = length - b - l; nondet = FALSE; break; default: /* sub_atom fixed */ if ((str = strstr(patom->name + b, psub_atom->name)) == NULL) return FALSE; b = str - patom->name; a = length - b - l; nondet = TRUE; break; } if (b < 0 || l < 0 || a < 0) return FALSE; if (nondet && Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1)) { /* non deterministic case */ A(0) = before_word; A(1) = length_word; A(2) = after_word; A(3) = sub_atom_word; A(4) = (WamWord) patom; A(5) = (WamWord) psub_atom; A(6) = mask; A(7) = b1; A(8) = l1; A(9) = a1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 10); } if (mask <= 7) { MALLOC_STR(l); strncpy(str, patom->name + b, l); str[l] = '\0'; Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word); Pl_Get_Integer(l, length_word); } return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word); } /*-------------------------------------------------------------------------* * PL_SUB_ATOM_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sub_Atom_Alt_0(void) { WamWord before_word, length_word, after_word, sub_atom_word; AtomInf *patom; AtomInf *psub_atom; int b, l, a; int b1, l1, a1; int mask; char *str; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 0); before_word = AB(B, 0); length_word = AB(B, 1); after_word = AB(B, 2); sub_atom_word = AB(B, 3); patom = (AtomInf *) AB(B, 4); psub_atom = (AtomInf *) AB(B, 5); mask = AB(B, 6); b = AB(B, 7); l = AB(B, 8); a = AB(B, 9); if (!Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1)) Delete_Last_Choice_Point(); else /* non deterministic case */ { #if 0 /* the following data is unchanged */ AB(B, 0) = before_word; AB(B, 1) = length_word; AB(B, 2) = after_word; AB(B, 3) = sub_atom_word; AB(B, 4) = (WamWord) patom; AB(B, 5) = (WamWord) psub_atom; AB(B, 6) = mask; #endif AB(B, 7) = b1; AB(B, 8) = l1; AB(B, 9) = a1; } if (mask <= 7) { MALLOC_STR(l); strncpy(str, patom->name + b, l); str[l] = '\0'; Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word); Pl_Get_Integer(l, length_word); } return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word); } /*-------------------------------------------------------------------------* * COMPUTE_NEXT_BLA * * * *-------------------------------------------------------------------------*/ static Bool Compute_Next_BLA(int mask, AtomInf *patom, AtomInf *psub_atom, int b, int l, int a, int *b1, int *l1, int *a1) { int length = patom->prop.length; char *str; switch (mask) /* mask B L A (1: fixed, 0: var) */ { case 0: /* nothing fixed */ if (++l > length - b) { l = 0; if (++b > length) return FALSE; } a = length - b - l; break; case 1: /* A fixed */ if (++b > length - a) return FALSE; l = length - b - a; break; case 2: /* L fixed */ if (++b > length - l) return FALSE; a = length - b - l; break; case 4: /* B fixed */ if (++l > length - b) return FALSE; a = length - b - l; break; default: /* sub_atom fixed */ if (++b > length - l) return FALSE; if ((str = strstr(patom->name + b, psub_atom->name)) == NULL) return FALSE; b = str - patom->name; a = length - b - l; break; } *b1 = b; *l1 = l; *a1 = a; return TRUE; } /*-------------------------------------------------------------------------* * CREATE_MALLOC_ATOM * * * *-------------------------------------------------------------------------*/ static int Create_Malloc_Atom(char *str) { int atom; int nb = pl_nb_atom; atom = Pl_Create_Atom(str); if (nb == pl_nb_atom) Free(str); return atom; } /*-------------------------------------------------------------------------* * PL_ATOM_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Chars_2(WamWord atom_word, WamWord chars_word) { WamWord word, tag_mask; DEREF(atom_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Un_Chars_Check(Pl_Rd_String_Check(word), chars_word); return Pl_Un_String_Check(Pl_Rd_Chars_Check(chars_word), atom_word); } /*-------------------------------------------------------------------------* * PL_ATOM_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Codes_2(WamWord atom_word, WamWord codes_word) { WamWord word, tag_mask; DEREF(atom_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Un_Codes_Check(Pl_Rd_String_Check(word), codes_word); return Pl_Un_String_Check(Pl_Rd_Codes_Check(codes_word), atom_word); } /*-------------------------------------------------------------------------* * PL_NUMBER_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Number_Atom_2(WamWord number_word, WamWord atom_word) { WamWord word, tag_mask; char *str; DEREF(atom_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) return String_To_Number(pl_atom_tbl[UnTag_ATM(word)].name, number_word); if (tag_mask != TAG_REF_MASK) Pl_Err_Type(pl_type_atom, word); DEREF(number_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { sprintf(pl_glob_buff, "%" PL_FMT_d, UnTag_INT(word)); return Pl_Un_String_Check(pl_glob_buff, atom_word); } str = Pl_Float_To_String(Pl_Rd_Number_Check(word)); return Pl_Un_String_Check(str, atom_word); } /*-------------------------------------------------------------------------* * PL_NUMBER_CHARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Number_Chars_2(WamWord number_word, WamWord chars_word) { WamWord word, tag_mask; WamWord *lst_adr, list_word; char *str = pl_glob_buff; int atom; list_word = chars_word; for (;;) { DEREF(list_word, word, tag_mask); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) goto from_nb; lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); atom = UnTag_ATM(word); if (tag_mask != TAG_ATM_MASK || pl_atom_tbl[atom].prop.length != 1) goto from_nb; *str++ = pl_atom_tbl[atom].name[0]; list_word = Cdr(lst_adr); } *str = '\0'; return String_To_Number(pl_glob_buff, number_word); from_nb: DEREF(number_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { sprintf(pl_glob_buff, "%" PL_FMT_d, UnTag_INT(word)); return Pl_Un_Chars_Check(pl_glob_buff, chars_word); } if (tag_mask != TAG_REF_MASK) { str = Pl_Float_To_String(Pl_Rd_Number_Check(word)); return Pl_Un_Chars_Check(str, chars_word); } Pl_Rd_Chars_Check(chars_word); /* only to raise the correct error */ return FALSE; } /*-------------------------------------------------------------------------* * PL_NUMBER_CODES_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Number_Codes_2(WamWord number_word, WamWord codes_word) { WamWord word, tag_mask; WamWord *lst_adr, list_word; char *str = pl_glob_buff; PlLong c; list_word = codes_word; for (;;) { DEREF(list_word, word, tag_mask); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) goto from_nb; lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); c = UnTag_INT(word); if (tag_mask != TAG_INT_MASK || !Is_Valid_Code(c)) goto from_nb; *str++ = (char) c; list_word = Cdr(lst_adr); } *str = '\0'; return String_To_Number(pl_glob_buff, number_word); from_nb: DEREF(number_word, word, tag_mask); if (tag_mask == TAG_INT_MASK) { sprintf(pl_glob_buff, "%" PL_FMT_d, UnTag_INT(word)); return Pl_Un_Codes_Check(pl_glob_buff, codes_word); } if (tag_mask != TAG_REF_MASK) { str = Pl_Float_To_String(Pl_Rd_Number_Check(word)); return Pl_Un_Codes_Check(str, codes_word); } Pl_Rd_Codes_Check(codes_word); /* only to raise the correct error */ return FALSE; } /*-------------------------------------------------------------------------* * PL_CHAR_CODE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Char_Code_2(WamWord char_word, WamWord code_word) { WamWord word, tag_mask; DEREF(char_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Un_Code_Check(Pl_Rd_Char_Check(word), code_word); return Pl_Un_Char_Check(Pl_Rd_Code_Check(code_word), char_word); } /*-------------------------------------------------------------------------* * PL_NAME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Name_2(WamWord atomic_word, WamWord codes_word) { WamWord word, tag_mask; int syn_flag; Bool is_number; char *str; DEREF(atomic_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) return Pl_Atom_Codes_2(word, codes_word); if (tag_mask == TAG_INT_MASK || tag_mask == TAG_FLT_MASK) return Pl_Number_Codes_2(word, codes_word); if (tag_mask != TAG_REF_MASK) Pl_Err_Type(pl_type_atomic, word); str = Pl_Rd_Codes_Check(codes_word); syn_flag = Flag_Value(syntax_error); Flag_Value(syntax_error) = PF_ERR_FAIL; is_number = String_To_Number(str, word); /* only fails on syn err */ Flag_Value(syntax_error) = syn_flag; if (is_number) return TRUE; return Pl_Un_String(str, word); } /*-------------------------------------------------------------------------* * PL_LOWER_UPPER_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Lower_Upper_2(WamWord lower_word, WamWord upper_word) { WamWord word, tag_mask; DEREF(lower_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Un_Char_Check(toupper(Pl_Rd_Char_Check(word)), upper_word); return Pl_Un_Char_Check(tolower(Pl_Rd_Char_Check(upper_word)), lower_word); } /*-------------------------------------------------------------------------* * STRING_TO_NUMBER * * * *-------------------------------------------------------------------------*/ static Bool String_To_Number(char *str, WamWord number_word) { WamWord word; int stm; StmInf *pstm; Bool eof; Pl_Check_For_Un_Number(number_word); /* #if 0 since layout leading chars allowed in ISO cf. number_chars */ #if 0 if (!isdigit(*str) && *str != '-') { Pl_Set_Last_Syntax_Error("", 1, 1, "non numeric character"); goto err; } #endif stm = Pl_Add_Str_Stream(str, TERM_STREAM_ATOM); pstm = pl_stm_tbl[stm]; word = Pl_Read_Number(pstm); eof = (Pl_Stream_Peekc(pstm) == EOF); if (word != NOT_A_WAM_WORD && !eof) Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm->atom_file_name].name, pstm->line_count + 1, pstm->line_pos + 1, "non numeric character"); Pl_Delete_Str_Stream(stm); if (word == NOT_A_WAM_WORD || !eof) { #if 0 err: #endif Pl_Syntax_Error(Flag_Value(syntax_error)); return FALSE; } return Pl_Unify(word, number_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Atom_2(WamWord atom_word, WamWord hide_word) { WamWord word, tag_mask; Bool hide; int atom; hide = Pl_Rd_Integer_Check(hide_word); DEREF(atom_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return *Pl_Rd_String_Check(word) != '$' || !hide; atom = -1; for (;;) { atom = Pl_Find_Next_Atom(atom); if (atom == -1) return FALSE; if (!hide || pl_atom_tbl[atom].name[0] != '$') break; } /* non deterministic case */ A(0) = atom_word; A(1) = hide; A(2) = atom; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ATOM_ALT, 0), 3); return Pl_Get_Atom(atom, atom_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_ATOM_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Atom_Alt_0(void) { WamWord atom_word; Bool hide; int atom; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ATOM_ALT, 0), 0); atom_word = AB(B, 0); hide = AB(B, 1); atom = AB(B, 2); for (;;) { atom = Pl_Find_Next_Atom(atom); if (atom == -1) { Delete_Last_Choice_Point(); return FALSE; } if (!hide || pl_atom_tbl[atom].name[0] != '$') break; } /* non deterministic case */ #if 0 /* the following data is unchanged */ AB(B, 0) = atom_word; AB(B, 1) = hide; #endif AB(B, 2) = atom; return Pl_Get_Atom(atom, atom_word); } /*-------------------------------------------------------------------------* * PL_ATOM_PROPERTY_6 * * * *-------------------------------------------------------------------------*/ void Pl_Atom_Property_6(WamWord atom_word, WamWord prefix_op_word, WamWord infix_op_word, WamWord postfix_op_word, WamWord needs_quote_word, WamWord needs_scan_word) { WamWord word, tag_mask; int atom; DEREF(atom_word, word, tag_mask); atom = UnTag_ATM(word); Pl_Get_Integer(Check_Oper(atom, PREFIX) != 0, prefix_op_word); Pl_Get_Integer(Check_Oper(atom, INFIX) != 0, infix_op_word); Pl_Get_Integer(Check_Oper(atom, POSTFIX) != 0, postfix_op_word); Pl_Get_Integer(pl_atom_tbl[atom].prop.needs_quote, needs_quote_word); Pl_Get_Integer(pl_atom_tbl[atom].prop.needs_scan, needs_scan_word); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/read.wam�������������������������������������������������������������������0000644�0001750�0001750�00000024435�13021356407�014734� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : read.pl file_name('/home/diaz/GP/src/BipsPl/read.pl'). predicate(system:'$use_read'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:read/1,49,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read,1]), call('$set_read_defaults'/0), put_value(y(0),0), deallocate, call_c('Pl_Read_1',[boolean],[x(0)]), proceed]). predicate(system:read/2,54,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_term/2,76,static,private,monofile,built_in,[ allocate(5), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_term,2]), call('$set_read_defaults'/0), put_value(y(1),0), put_variable(y(2),1), put_variable(y(3),2), put_variable(y(4),3), call('$get_read_options'/4), put_value(y(0),0), put_unsafe_value(y(2),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), deallocate, call_c('Pl_Read_Term_4',[boolean],[x(0),x(1),x(2),x(3)]), proceed]). predicate(system:read_term/3,83,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_term,3]), execute('$read_term'/3)]). predicate(system:'$read_term'/3,87,static,private,monofile,built_in,[ allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), call('$set_read_defaults'/0), put_value(y(2),0), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),3), call('$get_read_options'/4), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(3),2), put_unsafe_value(y(4),3), put_unsafe_value(y(5),4), deallocate, call_c('Pl_Read_Term_5',[boolean],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:'$set_read_defaults'/0,95,static,private,monofile,built_in,[ allocate(0), put_integer(0,0), put_integer(0,1), call('$sys_var_write'/2), put_integer(1,0), put_integer(-1,1), deallocate, execute('$sys_var_write'/2)]). predicate(system:'$get_read_options'/4,102,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(0),0), call('$check_list'/1), put_atom('$read_variables',0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$read_variable_names',0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$read_singletons',0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), call('$get_read_options1'/1), put_atom('$read_variables',0), put_value(y(1),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom('$read_variable_names',0), put_value(y(2),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_atom('$read_singletons',0), put_value(y(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed]). predicate(system:'$get_read_options1'/1,113,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(1),1), call('$get_read_options2'/1), cut(y(1)), put_value(y(0),0), deallocate, execute('$get_read_options1'/1)]). predicate(system:'$get_read_options2'/1,120,static,private,monofile,built_in,[ try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), execute('$pl_err_instantiation'/0), label(1), retry_me_else(13), switch_on_term(3,fail,fail,fail,2), label(2), switch_on_structure([(variables/1,4),(variable_names/1,6),(singletons/1,8),(syntax_error/1,10),(end_of_term/1,12)]), label(3), try_me_else(5), label(4), get_structure(variables/1,0), unify_variable(x(1)), call_c('Pl_Blt_List_Or_Partial_List',[fast_call,boolean],[x(1)]), put_atom('$read_variables',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), put_integer(0,0), put_integer(0,1), execute('$sys_var_set_bit'/2), label(5), retry_me_else(7), label(6), get_structure(variable_names/1,0), unify_variable(x(1)), call_c('Pl_Blt_List_Or_Partial_List',[fast_call,boolean],[x(1)]), put_atom('$read_variable_names',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), put_integer(0,0), put_integer(1,1), execute('$sys_var_set_bit'/2), label(7), retry_me_else(9), label(8), get_structure(singletons/1,0), unify_variable(x(1)), call_c('Pl_Blt_List_Or_Partial_List',[fast_call,boolean],[x(1)]), put_atom('$read_singletons',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), put_integer(0,0), put_integer(2,1), execute('$sys_var_set_bit'/2), label(9), retry_me_else(11), label(10), allocate(1), get_structure(syntax_error/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_read_options2/1_$aux1'/1), label(11), trust_me_else_fail, label(12), allocate(1), get_structure(end_of_term/1,0), unify_variable(y(0)), put_value(y(0),0), call('$check_nonvar'/1), put_value(y(0),0), deallocate, execute('$$get_read_options2/1_$aux2'/1), label(13), trust_me_else_fail, put_value(x(0),1), put_atom(read_option,0), execute('$pl_err_domain'/2)]). predicate(system:'$$get_read_options2/1_$aux2'/1,149,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(dot,3),(eof,5)]), label(2), try_me_else(4), label(3), get_atom(dot,0), put_integer(0,0), put_integer(3,1), execute('$sys_var_reset_bit'/2), label(4), trust_me_else_fail, label(5), get_atom(eof,0), put_integer(0,0), put_integer(3,1), execute('$sys_var_set_bit'/2)]). predicate(system:'$$get_read_options2/1_$aux1'/1,139,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(error,3),(warning,5),(fail,7)]), label(2), try_me_else(4), label(3), get_atom(error,0), put_integer(1,0), put_integer(0,1), execute('$sys_var_write'/2), label(4), retry_me_else(6), label(5), get_atom(warning,0), put_integer(1,0), put_integer(1,1), execute('$sys_var_write'/2), label(6), trust_me_else_fail, label(7), get_atom(fail,0), put_integer(1,0), put_integer(2,1), execute('$sys_var_write'/2)]). predicate(system:read_atom/1,163,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_atom,1]), call('$set_read_defaults'/0), put_value(y(0),0), deallocate, call_c('Pl_Read_Atom_1',[boolean],[x(0)]), proceed]). predicate(system:read_atom/2,169,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_atom,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_Atom_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_integer/1,177,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_integer,1]), call('$set_read_defaults'/0), put_value(y(0),0), deallocate, call_c('Pl_Read_Integer_1',[boolean],[x(0)]), proceed]). predicate(system:read_integer/2,183,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_integer,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_Integer_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_number/1,191,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_number,1]), call('$set_read_defaults'/0), put_value(y(0),0), deallocate, call_c('Pl_Read_Number_1',[boolean],[x(0)]), proceed]). predicate(system:read_number/2,197,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_number,2]), call('$set_read_defaults'/0), put_value(y(0),0), put_value(y(1),1), deallocate, call_c('Pl_Read_Number_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:read_token/1,205,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_token,1]), call_c('Pl_Read_Token_1',[boolean],[x(0)]), proceed]). predicate(system:read_token/2,209,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[read_token,2]), call_c('Pl_Read_Token_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:last_read_start_line_column/2,215,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[last_read_start_line_column,2]), call_c('Pl_Last_Read_Start_Line_Column_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:char_conversion/2,222,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[char_conversion,2]), call_c('Pl_Char_Conversion_2',[],[x(0),x(1)]), proceed]). predicate(system:current_char_conversion/2,229,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[current_char_conversion,2]), call_c('Pl_Current_Char_Conversion_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$current_char_conversion_alt'/0,236,static,private,monofile,built_in,[ call_c('Pl_Current_Char_Conversion_Alt_0',[boolean],[]), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/no_sockets.pl��������������������������������������������������������������0000644�0001750�0001750�00000005365�13021324543�016014� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : no_sockets.pl * * Descr.: no Sockets management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_sockets'. ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/stat_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000032140�13021324543�014720� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : stat_c.c * * Descr.: statistics predicate management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static PlLong last_user_time = 0; static PlLong last_system_time = 0; static PlLong last_cpu_time = 0; static PlLong last_real_time = 0; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Stack_Size(int stack_nb, int *used, int *free); /*-------------------------------------------------------------------------* * PL_STATISTICS_0 * * * *-------------------------------------------------------------------------*/ void Pl_Statistics_0(void) { StmInf *pstm = pl_stm_tbl[pl_stm_stdout]; int used, free; PlLong t[4], l[4]; static char *n[4] = { "user", "system", "cpu", "real" }; int i; Pl_Stream_Printf(pstm, "Memory limit in use free\n\n"); for (i = 0; i < NB_OF_STACKS; i++) { Stack_Size(i, &used, &free); if (used + free == 0) /* ie. size=0 (e.g. cstr_stack) */ continue; used /= 1024; free /= 1024; Pl_Stream_Printf(pstm, " %-6s stack %10d Kb %10d Kb %10d Kb\n", pl_stk_tbl[i].name, used + free, used, free); } #if 1 Pl_Stream_Printf(pstm, " atom table %10d atoms%10d atoms%10d atoms\n", pl_max_atom , pl_nb_atom, pl_max_atom - pl_nb_atom); #else Pl_Stream_Printf(pstm, "\nAtoms: %10d %10d max\n", pl_nb_atom, pl_max_atom); #endif t[0] = Pl_M_User_Time(); l[0] = t[0] - last_user_time; t[1] = Pl_M_System_Time(); l[1] = t[1] - last_system_time; t[2] = t[0] + t[1]; l[2] = t[2] - last_cpu_time; t[3] = Pl_M_Real_Time(); l[3] = t[3] - last_real_time; last_user_time = t[0]; last_system_time = t[1]; last_cpu_time = t[2]; last_real_time = t[3]; Pl_Stream_Printf(pstm, "\nTimes since start since last\n\n"); for (i = 0; i < 4; i++) Pl_Stream_Printf(pstm, " %-6s time %11.3f sec %11.3f sec\n", n[i], (double) t[i] / 1000.0, (double) l[i] / 1000.0); } /*-------------------------------------------------------------------------* * PL_STATISTICS_USER_TIME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_User_Time_2(WamWord since_start_word, WamWord since_last_word) { PlLong user_time; int since_start, since_last; user_time = Pl_M_User_Time(); since_start = user_time; since_last = user_time - last_user_time; last_user_time = user_time; return Pl_Un_Integer_Check(since_start, since_start_word) && Pl_Un_Integer_Check(since_last, since_last_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_SYSTEM_TIME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_System_Time_2(WamWord since_start_word, WamWord since_last_word) { PlLong system_time; int since_start, since_last; system_time = Pl_M_System_Time(); since_start = system_time; since_last = system_time - last_system_time; last_system_time = system_time; return Pl_Un_Integer_Check(since_start, since_start_word) && Pl_Un_Integer_Check(since_last, since_last_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_CPU_TIME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Cpu_Time_2(WamWord since_start_word, WamWord since_last_word) { PlLong cpu_time; int since_start, since_last; cpu_time = Pl_M_User_Time() + Pl_M_System_Time(); since_start = cpu_time; since_last = cpu_time - last_cpu_time; last_cpu_time = cpu_time; return Pl_Un_Integer_Check(since_start, since_start_word) && Pl_Un_Integer_Check(since_last, since_last_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_REAL_TIME_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Real_Time_2(WamWord since_start_word, WamWord since_last_word) { PlLong real_time; int since_start, since_last; real_time = Pl_M_Real_Time(); since_start = real_time; since_last = real_time - last_real_time; last_real_time = real_time; return Pl_Un_Integer_Check(since_start, since_start_word) && Pl_Un_Integer_Check(since_last, since_last_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_LOCAL_STACK_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Local_Stack_2(WamWord used_word, WamWord free_word) { int i, used, free; for (i = 0; i < NB_OF_STACKS; i++) if (pl_stk_tbl[i].stack == Local_Stack) Stack_Size(i, &used, &free); return Pl_Un_Integer_Check(used, used_word) && Pl_Un_Integer_Check(free, free_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_GLOBAL_STACK_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Global_Stack_2(WamWord used_word, WamWord free_word) { int i, used, free; for (i = 0; i < NB_OF_STACKS; i++) if (pl_stk_tbl[i].stack == Global_Stack) Stack_Size(i, &used, &free); return Pl_Un_Integer_Check(used, used_word) && Pl_Un_Integer_Check(free, free_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_TRAIL_STACK_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Trail_Stack_2(WamWord used_word, WamWord free_word) { int i, used, free; for (i = 0; i < NB_OF_STACKS; i++) if (pl_stk_tbl[i].stack == Trail_Stack) Stack_Size(i, &used, &free); return Pl_Un_Integer_Check(used, used_word) && Pl_Un_Integer_Check(free, free_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_CSTR_STACK_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Cstr_Stack_2(WamWord used_word, WamWord free_word) { int i, used, free; for (i = 0; i < NB_OF_STACKS; i++) if (pl_stk_tbl[i].stack == Cstr_Stack) Stack_Size(i, &used, &free); return Pl_Un_Integer_Check(used, used_word) && Pl_Un_Integer_Check(free, free_word); } /*-------------------------------------------------------------------------* * PL_STATISTICS_ATOMS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Statistics_Atoms_2(WamWord used_word, WamWord free_word) { return Pl_Un_Integer_Check(pl_nb_atom, used_word) && Pl_Un_Integer_Check(pl_max_atom - pl_nb_atom, free_word); } /*-------------------------------------------------------------------------* * STACK_SIZE * * * *-------------------------------------------------------------------------*/ static void Stack_Size(int stack_nb, int *used, int *free) { *used = Stack_Top(stack_nb) - pl_stk_tbl[stack_nb].stack; *free = pl_stk_tbl[stack_nb].size - *used; if (pl_stk_tbl[stack_nb].stack == Global_Stack) /* see Init_Wam_Engine */ *used += REG_BANK_SIZE; *used *= sizeof(WamWord); *free *= sizeof(WamWord); } /*-------------------------------------------------------------------------* * PL_USER_TIME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_User_Time_1(WamWord since_start_word) { return Pl_Un_Integer_Check(Pl_M_User_Time(), since_start_word); } /*-------------------------------------------------------------------------* * PL_SYSTEM_TIME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_System_Time_1(WamWord since_start_word) { return Pl_Un_Integer_Check(Pl_M_System_Time(), since_start_word); } /*-------------------------------------------------------------------------* * PL_CPU_TIME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Cpu_Time_1(WamWord since_start_word) { return Pl_Un_Integer_Check(Pl_M_User_Time() + Pl_M_System_Time(), since_start_word); } /*-------------------------------------------------------------------------* * PL_REAL_TIME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Real_Time_1(WamWord since_start_word) { return Pl_Un_Integer_Check(Pl_M_Real_Time(), since_start_word); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/write_supp.c���������������������������������������������������������������0000644�0001750�0001750�00000100017�13021324543�015643� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : write_supp.c * * Descr.: write term support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #include <ctype.h> #define OBJ_INIT Write_Supp_Initializer #define WRITE_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" /* spaces for non-assoc op (fx, xfx, xf) */ #if 0 #define SPACE_ARGS_RESTRICTED #endif /* spaces around the | inside lists */ #if 0 #define SPACE_ARGS_FOR_LIST_PIPE #endif /* spaces around the : (module qualification) */ #if 0 #define SPACE_ARGS_FOR_COLON #endif /* The output of the term -(T) using operator notation requires some attention if * the notation representation of T starts with a number. It is important to disinguish * between the compound term -(1) and the integer -1. * * If MINUS_SIGN_CAN_BE_FOLLOWED_BY_SPACES is not defined, we can simply use a space * -(1) can be output as - 1 * * If MINUS_SIGN_CAN_BE_FOLLOWED_BY_SPACES is defined we need brackets. * -(1) can be output as - (1) NB: -(1) is also OK but does not show the op notation * * The following macros control how brackets are handled around T (or part of T). For this * we consider 2 cases (pointed out by Ulrich Neumerkel). * * - (1^2) which is -(^(1,2)) and can produce - (1^2) or - (1)^2 * - (a^2) which is -(^(a,2)) and can produce - (a^2) or -a^2 * * OP_MINUS_BRACKETS_SIMPLE: to homegenize the output and to simplify the implementation, * brackets are used around T if T is a positive number or an {infix,postifx} op term * * writeq(- (1^2)) produces - (1^2) * writeq(- (a^2)) produces - (a^2) * * OP_MINUS_BRACKETS_SHORTEST: avoids useless brackets else the bracketed is as short as * possible. opening ( is before T, and closing ) can be inside T * * writeq(- (1^2)) produces - (1)^2 * writeq(- (a^2)) produces -a^2 * * OP_MINUS_BRACKETS_MIXED: avoids useless brackets else the whole T is bracketed. * * writeq(- (1^2)) produces - (1^2) as in OP_MINUS_BRACKETS_SIMPLE * writeq(- (a^2)) produces -a^2 as in OP_MINUS_BRACKETS_SHORTEST */ #if 0 #define OP_MINUS_BRACKETS_SIMPLE #elif 0 #define OP_MINUS_BRACKETS_SHORTEST #else #define OP_MINUS_BRACKETS_MIXED #endif /*---------------------------------* * Constants * *---------------------------------*/ #define W_NOTHING 0 /* for pl_last_writing */ #define W_NUMBER 1 #define W_NUMBER_0 2 /* to avoid 0'f ' if 'f ' is an op (avoid 0'char) */ #define W_IDENTIFIER 3 #define W_QUOTED 4 #define W_GRAPHIC 5 #define W_NO_PREFIX_OP 0 /* for last_prefix_op */ #define W_PREFIX_OP_ANY 1 #define W_PREFIX_OP_MINUS 2 #define GENERAL_TERM 0 #define INSIDE_ANY_OP 1 #define INSIDE_LEFT_ASSOC_OP 2 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static WamWord curly_brackets_1; static WamWord dollar_var_1; static WamWord dollar_varname_1; static int atom_dots; static StmInf *pstm_o; static Bool quoted; static Bool ignore_op; static Bool number_vars; static Bool name_vars; static Bool space_args; static Bool portrayed; static WamWord *name_number_above_H; static Bool last_is_space; /* to avoid duplicate spaces (e.g. with space_args) */ static int last_prefix_op = W_NO_PREFIX_OP; static Bool *p_bracket_op_minus; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Need_Space(int c); static void Out_Space(void); static void Out_Char(int c); static void Out_String(char *str); static void Show_Term(int depth, int prec, int context, WamWord term_word); static void Show_Global_Var(WamWord *adr); #ifndef NO_USE_FD_SOLVER static void Show_Fd_Variable(WamWord *fdv_adr); #endif static void Show_Atom(int context, int atom); static void Show_Integer(PlLong x); static void Show_Float(double x); static void Show_Number_Str(char *str); static void Show_List_Arg(int depth, WamWord *lst_adr); static void Show_Structure(int depth, int prec, int context, WamWord *stc_adr); static Bool Try_Portray(WamWord word); /*-------------------------------------------------------------------------* * WRITE_SUPP_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Write_Supp_Initializer(void) { atom_dots = Pl_Create_Atom("..."); curly_brackets_1 = Functor_Arity(pl_atom_curly_brackets, 1); dollar_var_1 = Functor_Arity(Pl_Create_Atom("$VAR"), 1); dollar_varname_1 = Functor_Arity(Pl_Create_Atom("$VARNAME"), 1); } /*-------------------------------------------------------------------------* * PL_WRITE_TERM * * * *-------------------------------------------------------------------------*/ void Pl_Write_Term(StmInf *pstm, int depth, int prec, int mask, WamWord *above_H, WamWord term_word) { pstm_o = pstm; quoted = mask & WRITE_QUOTED; ignore_op = mask & WRITE_IGNORE_OP; number_vars = mask & WRITE_NUMBER_VARS; name_vars = mask & WRITE_NAME_VARS; space_args = mask & WRITE_SPACE_ARGS; portrayed = mask & WRITE_PORTRAYED; name_number_above_H = above_H; last_is_space = FALSE; last_prefix_op = W_NO_PREFIX_OP; pl_last_writing = W_NOTHING; Show_Term(depth, prec, (prec >= 1200) ? GENERAL_TERM : INSIDE_ANY_OP, term_word); } /*-------------------------------------------------------------------------* * PL_WRITE * * * *-------------------------------------------------------------------------*/ void Pl_Write(WamWord term_word) { StmInf *pstm = pl_stm_tbl[pl_stm_output]; Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_NUMBER_VARS | WRITE_NAME_VARS, NULL, term_word); /* like write/1 */ } /*-------------------------------------------------------------------------* * OUT_SPACE * * * *-------------------------------------------------------------------------*/ static void Out_Space(void) { if (!last_is_space) /* avoid 2 consecutive space separators */ { Pl_Stream_Putc(' ', pstm_o); last_is_space = TRUE; } pl_last_writing = W_NOTHING; } /*-------------------------------------------------------------------------* * OUT_CHAR * * * *-------------------------------------------------------------------------*/ static void Out_Char(int c) { Need_Space(c); Pl_Stream_Putc(c, pstm_o); #if 0 /* actually, we do not use Out_Char to display spaces */ last_is_space = (c == ' '); /* use isspace ? */ #else last_is_space = FALSE; #endif } /*-------------------------------------------------------------------------* * OUT_STRING * * * *-------------------------------------------------------------------------*/ static void Out_String(char *str) { Need_Space(*str); Pl_Stream_Puts(str, pstm_o); /* Do not take into account space in strings , e.g. * write_term('ab ' + c,[space_args(true)]). * will output ab + c * to only have one space, simply activate the macro */ #if 0 last_is_space = (str[strlen(str) - 1] == ' '); /* use isspace ? */ #else last_is_space = FALSE; #endif } /*-------------------------------------------------------------------------* * NEED_SPACE * * * *-------------------------------------------------------------------------*/ static void Need_Space(int c) { int c_type = pl_char_type[c]; int space; switch (pl_last_writing) { case W_NUMBER_0: if (c_type == QT) { space = TRUE; break; } /* then in W_NUMBER */ case W_NUMBER: space = (c_type & (UL | CL | SL | DI)) || c == '.'; break; case W_IDENTIFIER: space = (c_type & (UL | CL | SL | DI)) || c == '[' || c == '{'; break; case W_QUOTED: space = (c_type == QT); break; case W_GRAPHIC: space = (c_type == GR); break; default: space = FALSE; } if (space || (c == '(' && last_prefix_op != W_NO_PREFIX_OP)) Out_Space(); else if (c_type == DI && last_prefix_op == W_PREFIX_OP_MINUS) { #ifndef MINUS_SIGN_CAN_BE_FOLLOWED_BY_SPACES Out_Space(); /* a space is enough to show - is an operator */ #else /* we need brackets to show - is an operator */ (*p_bracket_op_minus)++; #if 1 /* to show it is an op notation display a space (not strictly necessary) */ Out_Space(); #endif Out_Char('('); #endif } last_prefix_op = W_NO_PREFIX_OP; pl_last_writing = W_NOTHING; } /*-------------------------------------------------------------------------* * PL_WRITE_A_FULL_STOP * * * *-------------------------------------------------------------------------*/ void Pl_Write_A_Full_Stop(StmInf *pstm) { pstm_o = pstm; if (pl_last_writing == W_NUMBER_0 || pl_last_writing == W_NUMBER) pl_last_writing = W_NOTHING; Out_Char('.'); Out_Char('\n'); } /*-------------------------------------------------------------------------* * PL_WRITE_A_CHAR * * * *-------------------------------------------------------------------------*/ void Pl_Write_A_Char(StmInf *pstm, int c) { pstm_o = pstm; Out_Char(c); } /*-------------------------------------------------------------------------* * PL_FLOAT_TO_STRING * * * *-------------------------------------------------------------------------*/ char * Pl_Float_To_String(double d) { char *p, *q, *e; static char buff[32]; sprintf(buff, "%#.17g", d); /* a . with 16 significant digits */ p = buff; /* skip leading blanks */ while (*p == ' ') p++; if (p != buff) /* remove leading blanks */ { q = buff; while ((*q++ = *p++)) ; } p = strchr(buff, '.'); if (p == NULL) /* if p==NULL then NaN or +/-inf (ignore) */ return buff; if (p[1] == '\0') /* a dot but no decimal numbers */ { strcat(buff, "0"); return buff; } e = strchr(buff, 'e'); /* search exposant part */ if (e == NULL) e = buff + strlen(buff); p = e - 1; while (*p == '0') p--; q = (*p == '.') ? p + 2 : p + 1; /* but keep at least one 0 */ if (q != e) while ((*q++ = *e++)) /* move exposant part */ ; return buff; } /*-------------------------------------------------------------------------* * SHOW_TERM * * * *-------------------------------------------------------------------------*/ static void Show_Term(int depth, int prec, int context, WamWord term_word) { WamWord word, tag_mask; WamWord *adr; if (depth == 0) { Show_Atom(GENERAL_TERM, atom_dots); return; } DEREF(term_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && Try_Portray(word)) return; switch (Tag_From_Tag_Mask(tag_mask)) { case REF: adr = UnTag_REF(word); if (Is_A_Local_Adr(adr)) { Globalize_Local_Unbound_Var(adr, word); adr = UnTag_REF(word); } Show_Global_Var(adr); break; case ATM: Show_Atom(context, UnTag_ATM(word)); break; #ifndef NO_USE_FD_SOLVER case FDV: Show_Fd_Variable(UnTag_FDV(word)); break; #endif case INT: Show_Integer(UnTag_INT(word)); break; case FLT: Show_Float(Pl_Obtain_Float(UnTag_FLT(word))); break; case LST: adr = UnTag_LST(word); if (ignore_op) { Out_String("'.'("); Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Car(adr)); Out_Char(','); Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Cdr(adr)); Out_Char(')'); } else { Out_Char('['); Show_List_Arg(depth, adr); Out_Char(']'); } break; case STC: adr = UnTag_STC(word); Show_Structure(depth, prec, context, adr); break; } } /*-------------------------------------------------------------------------* * SHOW_GLOBAL_VAR * * * *-------------------------------------------------------------------------*/ static void Show_Global_Var(WamWord *adr) { char str[32]; sprintf(str, "_%d", (int) Global_Offset(adr)); Out_String(str); pl_last_writing = W_IDENTIFIER; } #ifndef NO_USE_FD_SOLVER /*-------------------------------------------------------------------------* * SHOW_FD_VARIABLE * * * *-------------------------------------------------------------------------*/ static void Show_Fd_Variable(WamWord *fdv_adr) { char str[32]; sprintf(str, "_#%d(", (int) Cstr_Offset(fdv_adr)); Out_String(str); Out_String(Fd_Variable_To_String(fdv_adr)); Out_Char(')'); pl_last_writing = W_IDENTIFIER; } #endif /*-------------------------------------------------------------------------* * SHOW_ATOM * * * *-------------------------------------------------------------------------*/ static void Show_Atom(int context, int atom) { char *p, *q; char str[32]; Bool bracket = FALSE; int c, c_type; AtomProp prop; prop = pl_atom_tbl[atom].prop; if (context != GENERAL_TERM && Check_Oper_Any_Type(atom)) { Out_Char('('); bracket = TRUE; } if (!quoted || !prop.needs_quote) { Out_String(pl_atom_tbl[atom].name); switch (prop.type) { case IDENTIFIER_ATOM: pl_last_writing = W_IDENTIFIER; break; case GRAPHIC_ATOM: pl_last_writing = W_GRAPHIC; break; case SOLO_ATOM: pl_last_writing = W_NOTHING; break; case OTHER_ATOM: if (prop.length == 0) { pl_last_writing = W_NOTHING; break; } c = pl_atom_tbl[atom].name[prop.length - 1]; c_type = pl_char_type[c]; if (c_type & (UL | CL | SL | DI)) pl_last_writing = W_IDENTIFIER; else if (c == '\'') pl_last_writing = W_QUOTED; else if (c_type == GR) pl_last_writing = W_GRAPHIC; else pl_last_writing = W_NOTHING; } } else { Out_Char('\''); if (prop.needs_scan) { for (p = pl_atom_tbl[atom].name; *p; p++) if ((q = (char *) strchr(pl_escape_char, *p))) { Out_Char('\\'); Out_Char(pl_escape_symbol[q - pl_escape_char]); } else if (*p == '\'' || *p == '\\') /* display twice */ { Out_Char(*p); Out_Char(*p); } else if (!isprint(*p)) { sprintf(str, "\\x%x\\", (unsigned) (unsigned char) *p); Out_String(str); } else Out_Char(*p); } else Out_String(pl_atom_tbl[atom].name); Out_Char('\''); pl_last_writing = W_QUOTED; } if (bracket) Out_Char(')'); } /*-------------------------------------------------------------------------* * SHOW_INTEGER * * * *-------------------------------------------------------------------------*/ static void Show_Integer(PlLong x) { char str[32]; sprintf(str, "%" PL_FMT_d, x); Show_Number_Str(str); } /*-------------------------------------------------------------------------* * SHOW_FLOAT * * * *-------------------------------------------------------------------------*/ static void Show_Float(double x) { Show_Number_Str(Pl_Float_To_String(x)); } /*-------------------------------------------------------------------------* * SHOW_NUMBER_STR * * * *-------------------------------------------------------------------------*/ static void Show_Number_Str(char *str) { #ifdef OP_MINUS_BRACKETS_SHORTEST int cur_bracket_op_minus = (last_prefix_op == W_PREFIX_OP_MINUS) ? *p_bracket_op_minus : -1; #endif Out_String(str); /* Suppose a term -(15)^8 which is -(^(15,8)) * we are here on the number 15, ie. the "-" has been displayed * The Out_String(str) displayed " (15" and *p_bracket_op_minus has been incremented * If nothing is done, the closing ) will be displayed after ^8 resulting in - (15^8) * With the next test we detect it and close the ) after the 15 resulting in - (15)^8 * Both are OK (the first on corresponds to OP_MINUS_BRACKETS_SIMPLE/MIXED) */ #ifdef OP_MINUS_BRACKETS_SHORTEST if (cur_bracket_op_minus >= 0 && cur_bracket_op_minus != *p_bracket_op_minus) { Out_Char(')'); (*p_bracket_op_minus)--; pl_last_writing = W_NOTHING; } else #endif pl_last_writing = (*str == '0' && str[1] == '\0') ? W_NUMBER_0 : W_NUMBER; } /*-------------------------------------------------------------------------* * SHOW_LIST_ARG * * * *-------------------------------------------------------------------------*/ #ifdef SPACE_ARGS_FOR_LIST_PIPE #define SHOW_LIST_PIPE if (space_args) Out_String(" | "); else Out_Char('|') #else #define SHOW_LIST_PIPE Out_Char('|') #endif static void Show_List_Arg(int depth, WamWord *lst_adr) { WamWord word, tag_mask; terminal_rec: depth--; Show_Term(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Car(lst_adr)); if (depth == 0) /* dots already written by Show_Term */ return; DEREF(Cdr(lst_adr), word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { case REF: SHOW_LIST_PIPE; Show_Global_Var(UnTag_REF(word)); break; case ATM: if (word != NIL_WORD) { SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Atom(GENERAL_TERM, UnTag_ATM(word)); } break; #ifndef NO_USE_FD_SOLVER case FDV: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Fd_Variable(UnTag_FDV(word)); break; #endif case INT: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Integer(UnTag_INT(word)); break; case FLT: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Float(Pl_Obtain_Float(UnTag_FLT(word))); break; case LST: Out_Char(','); if (space_args) Out_Space(); lst_adr = UnTag_LST(word); goto terminal_rec; break; case STC: SHOW_LIST_PIPE; if (Try_Portray(word)) return; Show_Structure(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, UnTag_STC(word)); break; } } /*-------------------------------------------------------------------------* * IS_VALID_VAR_NAME * * * *-------------------------------------------------------------------------*/ static Bool Is_Valid_Var_Name(char *str) { int c_type; c_type = pl_char_type[(unsigned) *str]; if ((c_type & (UL | CL)) == 0) /* neither underline nor capital letter */ return FALSE; while(*++str != '\0') { c_type = pl_char_type[(unsigned) *str]; if ((c_type & (UL | CL | SL | DI)) == 0) return FALSE; } return TRUE; } /*-------------------------------------------------------------------------* * PL_IS_VALID_VAR_NAME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Is_Valid_Var_Name_1(WamWord name_word) { WamWord word, tag_mask; DEREF(name_word, word, tag_mask); return (tag_mask == TAG_ATM_MASK) && Is_Valid_Var_Name(pl_atom_tbl[UnTag_ATM(word)].name); } /*-------------------------------------------------------------------------* * SHOW_STRUCTURE * * * *-------------------------------------------------------------------------*/ static void Show_Structure(int depth, int prec, int context, WamWord *stc_adr) { WamWord word, tag_mask; WamWord *adr; WamWord f_n = Functor_And_Arity(stc_adr); int functor = Functor(stc_adr); int arity = Arity(stc_adr); OperInf *oper; int nb_args_to_disp; int i, j, n; char str[32]; Bool bracket; Bool surround_space; depth--; if (name_vars && f_n == dollar_varname_1 && stc_adr >= name_number_above_H) { DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask == TAG_ATM_MASK) { #if 0 /* check the validity of the atom */ char *p = pl_atom_tbl[UnTag_ATM(word)].name; if (Is_Valid_Var_Name(p)) { Out_String(p); pl_last_writing = W_IDENTIFIER; return; } #else /* accept any atom - call Show_Atom to set pl_last_writing */ int save_quoted = quoted; quoted = FALSE; Show_Atom(GENERAL_TERM, UnTag_ATM(word)); /* could pass context instead of GENERAL_TERM */ quoted = save_quoted; return; #endif } } if (number_vars && f_n == dollar_var_1 && stc_adr >= name_number_above_H) { DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask == TAG_INT_MASK && (n = UnTag_INT(word)) >= 0) { i = n % 26; j = n / 26; Out_Char('A' + i); if (j) { sprintf(str, "%d", j); Out_String(str); } pl_last_writing = W_IDENTIFIER; return; } } if (ignore_op || arity > 2) goto functional; if (f_n == curly_brackets_1) { Out_Char('{'); if (space_args) Out_Space(); Show_Term(depth, MAX_PREC, GENERAL_TERM, Arg(stc_adr, 0)); if (space_args) Out_Space(); Out_Char('}'); return; } bracket = FALSE; if (arity == 1 && (oper = Pl_Lookup_Oper(functor, PREFIX))) { #if 1 /* Koen de Bosschere says "in case of ambiguity : */ /* select the associative operator over the nonassociative */ /* select prefix over postfix". */ OperInf *oper1; if (oper->prec > oper->right && (oper1 = Pl_Lookup_Oper(functor, POSTFIX)) && oper1->left == oper1->prec) { oper = oper1; goto postfix; } #endif if (oper->prec > prec || (context == INSIDE_LEFT_ASSOC_OP && (oper->prec == oper->right && oper->prec == prec))) { /* prevent also the case: fy T yf(x) */ Out_Char('('); bracket = TRUE; } Show_Atom(GENERAL_TERM, functor); last_prefix_op = W_PREFIX_OP_ANY; if (space_args #if SPACE_ARGS_RESTRICTED /* space_args -> space after fx operator */ && oper->prec > oper->right #endif ) Out_Space(); if (strcmp(pl_atom_tbl[functor].name, "-") == 0) { last_prefix_op = W_PREFIX_OP_MINUS; p_bracket_op_minus = &bracket; } Show_Term(depth, oper->right, INSIDE_ANY_OP, Arg(stc_adr, 0)); last_prefix_op = W_NO_PREFIX_OP; /* Here we need a while(bracket--) instead of if(bracket) because * in some cases with the minus op an additional bracket is needed. * Example: with op(100, xfx, &) (recall the prec of - is 200). * The term ((-(1)) & b must be displayed as: (- (1)) & b * Concerning the sub-term - (1), the first ( is emitted 10 lines above * because the precedence of - (200) is > precedence of & (100). * The second ( is emitted by Need_Space() because the argument of - begins * by a digit. At the return we have to close 2 ). */ while (bracket--) Out_Char(')'); return; } if (arity == 1 && (oper = Pl_Lookup_Oper(functor, POSTFIX))) { postfix: if (oper->prec > prec #ifdef OP_MINUS_BRACKETS_SIMPLE || last_prefix_op == W_PREFIX_OP_MINUS #endif ) { Out_Char('('); bracket = TRUE; } context = (oper->left == oper->prec) ? INSIDE_LEFT_ASSOC_OP : INSIDE_ANY_OP; Show_Term(depth, oper->left, context, Arg(stc_adr, 0)); if (space_args #if SPACE_ARGS_RESTRICTED /* space_args -> space before xf operator */ && oper->prec > oper->left #endif ) Out_Space(); Show_Atom(GENERAL_TERM, functor); if (bracket) Out_Char(')'); return; } if (arity == 2 && (oper = Pl_Lookup_Oper(functor, INFIX))) { if (oper->prec > prec || (context == INSIDE_LEFT_ASSOC_OP && (oper->prec == oper->right && oper->prec == prec)) #ifdef OP_MINUS_BRACKETS_SIMPLE || last_prefix_op == W_PREFIX_OP_MINUS #endif ) { /* prevent also the case: T xfy U yf(x) */ Out_Char('('); bracket = TRUE; } context = (oper->left == oper->prec) ? INSIDE_LEFT_ASSOC_OP : INSIDE_ANY_OP; Show_Term(depth, oper->left, context, Arg(stc_adr, 0)); #if 1 /* to show | unquoted if it is an infix operator with prec > 1000 */ if (functor == ATOM_CHAR('|') && oper->prec > 1000) { if (space_args) Out_Space(); Out_Char('|'); if (space_args) Out_Space(); } else #endif if (functor == ATOM_CHAR(',')) { Out_Char(','); if (space_args) Out_Space(); } else { surround_space = FALSE; if (pl_atom_tbl[functor].prop.type == IDENTIFIER_ATOM || pl_atom_tbl[functor].prop.type == OTHER_ATOM || (space_args #ifdef SPACE_ARGS_RESTRICTED /* space_args -> space around xfx operators */ && oper->left != oper->prec && oper->right != oper->prec #endif #ifndef SPACE_ARGS_FOR_COLON && (functor != ATOM_CHAR(':')) #endif )) { surround_space = TRUE; Out_Space(); } Show_Atom(GENERAL_TERM, functor); if (surround_space) Out_Space(); } Show_Term(depth, oper->right, INSIDE_ANY_OP, Arg(stc_adr, 1)); if (bracket) Out_Char(')'); return; } functional: /* functional notation */ Show_Atom(GENERAL_TERM, functor); Out_Char('('); nb_args_to_disp = i = (arity < depth + 1 || depth < 0) ? arity : depth + 1; adr = &Arg(stc_adr, 0); goto start_display; do { Out_Char(','); if (space_args) Out_Space(); start_display: Show_Term(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, *adr++); } while (--i); if (arity != nb_args_to_disp) { Out_Char(','); if (space_args) Out_Space(); Show_Atom(GENERAL_TERM, atom_dots); } Out_Char(')'); } /*-------------------------------------------------------------------------* * TRY_PORTRAY * * * *-------------------------------------------------------------------------*/ static Bool Try_Portray(WamWord word) { #ifdef FOR_EXTERNAL_USE return FALSE; #else PredInf *pred; StmInf *print_pstm_o; Bool print_quoted; Bool print_ignore_op; Bool print_number_vars; Bool print_name_vars; Bool print_space_args; Bool print_portrayed; Bool print_ok; static CodePtr try_portray_code = NULL; if (!portrayed) return FALSE; if (try_portray_code == NULL) { /* FIXME pass Module to user portray (need meta_predicate decl) */ pred = Pl_Check_Sys_Pred_Exist("$try_portray", 1); if (pred == NULL || pred->codep == NULL) Pl_Err_Resource(pl_resource_print_object_not_linked); try_portray_code = (CodePtr) (pred->codep); } print_pstm_o = pstm_o; print_quoted = quoted; print_ignore_op = ignore_op; print_number_vars = number_vars; print_name_vars = name_vars; print_space_args = space_args; print_portrayed = portrayed; A(0) = word; print_ok = Pl_Call_Prolog(try_portray_code); pstm_o = print_pstm_o; quoted = print_quoted; ignore_op = print_ignore_op; number_vars = print_number_vars; name_vars = print_name_vars; space_args = print_space_args; portrayed = print_portrayed; return print_ok; #endif } /*-------------------------------------------------------------------------* * PL_GET_PRINT_STM_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Print_Stm_1(WamWord stm_word) { int stm = Pl_Find_Stream_From_PStm(pstm_o); if (stm < 0) stm = pl_stm_output; return Pl_Get_Integer(stm, stm_word); } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/random_c.c�����������������������������������������������������������������0000644�0001750�0001750�00000012366�13021324543�015235� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : random_c.c * * Descr.: random number generator management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_SET_SEED_1 * * * *-------------------------------------------------------------------------*/ void Pl_Set_Seed_1(WamWord seed_word) { Pl_M_Set_Seed(Pl_Rd_Positive_Check(seed_word)); } /*-------------------------------------------------------------------------* * PL_GET_SEED_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Seed_1(WamWord seed_word) { return Pl_Un_Positive_Check(Pl_M_Get_Seed(), seed_word); } /*-------------------------------------------------------------------------* * PL_RANDOM_1 * * * *-------------------------------------------------------------------------*/ void Pl_Random_1(WamWord n_word) { Pl_Check_For_Un_Variable(n_word); Pl_Get_Float(Pl_M_Random_Float(1.0), n_word); } /*-------------------------------------------------------------------------* * PL_RANDOM_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Random_3(WamWord l_word, WamWord u_word, WamWord n_word) { double l, u; PlLong l1, u1; PlLong i; double d; l = Pl_Rd_Number_Check(l_word); u = Pl_Rd_Number_Check(u_word); Pl_Check_For_Un_Variable(n_word); if (l >= u) return FALSE; l1 = (PlLong) l; u1 = (PlLong) u; if (l1 == l && u1 == u) { i = l1 + Pl_M_Random_Integer(u1 - l1); Pl_Get_Integer(i, n_word); } else { d = l + Pl_M_Random_Float(u - l); Pl_Get_Float(d, n_word); } return TRUE; } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/debugger.wam���������������������������������������������������������������0000644�0001750�0001750�00000230716�13021356407�015606� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : debugger.pl file_name('/home/diaz/GP/src/BipsPl/debugger.pl'). predicate(system:'$init_debugger'/0,41,static,private,monofile,built_in,[ allocate(0), put_integer(13,0), put_integer(1,1), call('$sys_var_write'/2), put_structure(d/2,1), unify_integer(0), unify_nil, put_atom('$debug_info',0), call_c('Pl_Blt_G_Link',[fast_call],[x(0),x(1)]), deallocate, execute('$debug_switch_off'/0)]). predicate(system:'$debug_switch_off'/0,50,static,private,monofile,built_in,[ put_atom('$debug_mode',0), put_atom(nodebug,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$debug_next',0), put_atom(nodebug,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$debug_leash',0), put_integer(31,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$debug_depth',0), put_integer(10,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), call_c('Pl_Reset_Debug_Call_Code_0',[],[]), proceed]). predicate(system:'$debug_switch_on'/1,59,static,private,monofile,built_in,[ allocate(1), put_atom('$debug_mode',1), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(0)]), put_atom('$debug_next',1), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(0)]), put_atom('$debug_info',0), put_variable(y(0),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_integer(1,0), put_value(y(0),1), put_integer(0,2), put_atom(false,3), call(setarg/4), put_integer(2,0), put_value(y(0),1), put_nil(2), put_atom(false,3), call(setarg/4), deallocate, call_c('Pl_Set_Debug_Call_Code_0',[],[]), proceed]). predicate(system:wam_debug/0,72,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[wam_debug,0]), call_c('Pl_Debug_Wam',[],[]), proceed]). predicate(system:notrace/0,79,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[notrace,0]), execute(nodebug/0)]). predicate(system:nodebug/0,86,static,private,monofile,built_in,[ allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[nodebug,0]), call('$debug_switch_off'/0), deallocate, execute('$show_debugger_mode'/0)]). predicate(system:trace/0,92,static,private,monofile,built_in,[ allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[trace,0]), put_atom(trace,0), call('$debug_switch_on'/1), deallocate, execute('$show_debugger_mode'/0)]). predicate(system:debug/0,98,static,private,monofile,built_in,[ allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[debug,0]), put_atom(debug,0), call('$debug_switch_on'/1), deallocate, execute('$show_debugger_mode'/0)]). predicate(system:'$show_debugger_mode'/0,106,static,private,monofile,built_in,[ allocate(0), put_atom('$debug_mode',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call('$show_debugger_mode1'/1), put_atom(debugger_output,0), deallocate, execute(nl/1)]). predicate(system:'$show_debugger_mode1'/1,112,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(nodebug,3),(trace,5),(debug,7)]), label(2), try_me_else(4), label(3), get_atom(nodebug,0), put_atom(debugger_output,0), put_atom('The debugger is switched off',1), execute(write/2), label(4), retry_me_else(6), label(5), allocate(0), get_atom(trace,0), put_atom(debugger_output,0), put_atom('The debugger will first creep -- ',1), call(write/2), put_atom(debugger_output,0), put_atom('showing everything (trace)',1), deallocate, execute(write/2), label(6), trust_me_else_fail, label(7), allocate(0), get_atom(debug,0), put_atom(debugger_output,0), put_atom('The debugger will first leap -- ',1), call(write/2), put_atom(debugger_output,0), put_atom('showing spypoints (debug)',1), deallocate, execute(write/2)]). predicate(system:debugging/0,126,static,private,monofile,built_in,[ allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[debugging,0]), call('$show_debugger_mode'/0), call('$show_leashing_info'/0), call('$show_undefined_action'/0), deallocate, execute('$show_spy_points'/0)]). predicate(system:leash/1,136,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[leash,1]), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(1)), execute('$pl_err_instantiation'/0), label(1), retry_me_else(13), switch_on_term(3,2,fail,fail,fail), label(2), switch_on_atom([(full,4),(half,6),(loose,8),(none,10),(tight,12)]), label(3), try_me_else(5), label(4), get_atom(full,0), cut(x(1)), put_list(0), unify_atom(call), unify_list, unify_atom(exit), unify_list, unify_atom(redo), unify_list, unify_atom(fail), unify_list, unify_atom(exception), unify_nil, execute(leash/1), label(5), retry_me_else(7), label(6), get_atom(half,0), cut(x(1)), put_list(0), unify_atom(call), unify_list, unify_atom(redo), unify_nil, execute(leash/1), label(7), retry_me_else(9), label(8), get_atom(loose,0), cut(x(1)), put_list(0), unify_atom(call), unify_nil, execute(leash/1), label(9), retry_me_else(11), label(10), get_atom(none,0), cut(x(1)), put_nil(0), execute(leash/1), label(11), trust_me_else_fail, label(12), get_atom(tight,0), cut(x(1)), put_list(0), unify_atom(call), unify_list, unify_atom(redo), unify_list, unify_atom(fail), unify_list, unify_atom(exception), unify_nil, execute(leash/1), label(13), retry_me_else(14), allocate(2), get_variable(y(0),1), put_variable(y(1),1), call('$leash_make_mask'/2), cut(y(0)), put_atom('$debug_leash',0), put_unsafe_value(y(1),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, execute('$show_leashing_info'/0), label(14), trust_me_else_fail, put_value(x(0),1), put_atom(leash_ports,0), execute('$pl_err_domain'/2)]). predicate(system:'$leash_make_mask'/2,169,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_integer(0,1), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(1),1), get_list(0), unify_variable(y(0)), unify_variable(x(0)), put_variable(y(2),1), call('$leash_make_mask'/2), put_value(y(0),0), put_variable(y(3),1), call('$debug_port_mask'/2), math_fast_load_value(y(2),0), math_fast_load_value(y(3),1), call_c('Pl_Fct_Fast_Or',[fast_call,x(0)],[x(0),x(1)]), get_value(y(1),0), deallocate, proceed]). predicate(system:'$show_leashing_info'/0,179,static,private,monofile,built_in,[ allocate(0), put_atom('$debug_leash',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call('$show_leashing_info1'/1), put_atom(debugger_output,0), deallocate, execute(nl/1)]). predicate(system:'$show_leashing_info1'/1,185,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_integer(0,0), cut(x(1)), put_atom(debugger_output,0), put_atom('No leashing',1), execute(write/2), label(1), trust_me_else_fail, allocate(1), get_variable(y(0),0), put_atom(debugger_output,0), put_atom('Using leashing stopping at ',1), call(write/2), put_atom('$debug_work',0), put_integer(91,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), call('$show_leashing_info2'/1), put_atom(debugger_output,0), put_atom('] ports',1), deallocate, execute(write/2)]). predicate(system:'$show_leashing_info2'/1,196,static,private,monofile,built_in,[ try_me_else(1), allocate(3), get_variable(y(0),0), put_variable(y(1),0), put_variable(y(2),1), call('$debug_port_mask'/2), math_fast_load_value(y(0),0), math_fast_load_value(y(2),1), call_c('Pl_Fct_Fast_And',[fast_call,x(0)],[x(0),x(1)]), put_integer(0,1), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(1)]), put_atom('$debug_work',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_atom('$debug_work',1), put_integer(44,2), call_c('Pl_Blt_G_Assign',[fast_call],[x(1),x(2)]), put_list(2), unify_value(x(0)), unify_list, unify_local_value(y(1)), unify_nil, put_atom(debugger_output,0), put_atom('~c~a',1), call(format/3), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$debug_is_not_leashed'/1,209,static,private,monofile,built_in,[ allocate(2), put_atom('$debug_leash',1), put_variable(y(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_variable(y(1),1), call('$debug_port_mask'/2), math_fast_load_value(y(1),0), math_fast_load_value(y(0),1), call_c('Pl_Fct_Fast_And',[fast_call,x(0)],[x(0),x(1)]), put_integer(0,1), call_c('Pl_Blt_Fast_Eq',[fast_call,boolean],[x(0),x(1)]), deallocate, proceed]). predicate(system:'$debug_port_mask'/2,217,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(call,3),(exit,5),(redo,7),(fail,9),(exception,11)]), label(2), try_me_else(4), label(3), get_atom(call,0), get_integer(1,1), proceed, label(4), retry_me_else(6), label(5), get_atom(exit,0), get_integer(2,1), proceed, label(6), retry_me_else(8), label(7), get_atom(redo,0), get_integer(4,1), proceed, label(8), retry_me_else(10), label(9), get_atom(fail,0), get_integer(8,1), proceed, label(10), trust_me_else_fail, label(11), get_atom(exception,0), get_integer(16,1), proceed]). predicate(system:'$show_undefined_action'/0,230,static,private,monofile,built_in,[ allocate(1), put_atom(unknown,0), put_variable(y(0),1), call(current_prolog_flag/2), put_atom(debugger_output,0), put_atom('Undefined predicates will ',1), call(write/2), put_value(y(0),0), call('$show_undefined_action1'/1), put_atom(debugger_output,0), deallocate, execute(nl/1)]). predicate(system:'$show_undefined_action1'/1,237,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(error,3),(warning,5),(fail,7)]), label(2), try_me_else(4), label(3), get_atom(error,0), put_atom(debugger_output,0), put_atom('raise an existence_error',1), execute(write/2), label(4), retry_me_else(6), label(5), get_atom(warning,0), put_atom(debugger_output,0), put_atom('display a warning message and fail',1), execute(write/2), label(6), trust_me_else_fail, label(7), get_atom(fail,0), put_atom(debugger_output,0), put_atom(fail,1), execute(write/2)]). predicate(system:spypoint_condition/3,251,static,private,monofile,built_in,[ allocate(4), get_variable(y(0),1), get_variable(y(1),2), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[spypoint_condition,3]), put_variable(y(2),1), put_variable(y(3),2), call('$strip_module_nonvar'/3), put_unsafe_value(y(3),0), put_unsafe_value(y(2),1), put_value(y(0),2), put_value(y(1),3), deallocate, execute('$spypoint_condition1'/4)]). predicate(system:'$spypoint_condition1'/4,257,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(4)), execute('$pl_err_instantiation'/0), label(1), retry_me_else(2), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), cut(x(4)), execute('$spypoint_condition2'/4), label(2), trust_me_else_fail, put_value(x(0),1), put_atom(callable,0), execute('$pl_err_type'/2)]). predicate(system:'$spypoint_condition2'/4,269,static,private,monofile,built_in,[ try_me_else(1), allocate(0), get_variable(x(5),3), get_variable(x(4),2), get_variable(x(6),1), get_variable(x(3),0), put_variable(x(1),0), put_variable(x(2),7), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(3),x(0),x(7)]), put_value(x(6),0), call('$$spypoint_condition2/4_$aux1'/6), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$$spypoint_condition2/4_$aux1'/6,269,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(7), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_variable(y(5),6), put_value(y(0),1), put_value(y(1),2), put_variable(y(6),3), call('$get_module_of_pred'/4), cut(y(5)), put_structure((:)/2,1), unify_local_value(y(6)), unify_structure((/)/2), unify_local_value(y(0)), unify_local_value(y(1)), put_list(0), unify_value(x(1)), unify_nil, put_structure(c/3,1), unify_local_value(y(2)), unify_local_value(y(3)), unify_local_value(y(4)), call('$debug_spy_set'/2), put_atom('$debug_mode',0), put_atom(nodebug,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), deallocate, execute(debug/0), label(1), trust_me_else_fail, allocate(1), get_variable(x(3),2), get_variable(x(2),0), put_value(x(1),0), put_value(x(3),1), put_variable(y(0),3), call('$debug_qualify_pi_pretty'/4), put_atom(debugger_output,0), put_atom('Warning: The predicate ~q is undefined~n',1), put_list(2), unify_local_value(y(0)), unify_nil, deallocate, execute(format/3)]). predicate(system:spy/1,288,static,private,monofile,built_in,[ try_me_else(1), allocate(3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[spy,1]), put_variable(y(0),1), put_variable(y(1),2), call('$strip_module_nonvar'/3), put_value(y(1),0), put_value(y(0),1), put_variable(y(2),2), call('$debug_list_of_pred'/3), put_value(y(2),0), put_void(1), call('$debug_spy_set'/2), put_value(y(2),0), put_nil(1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom('$debug_mode',0), put_atom(nodebug,1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), call(debug/0), fail, label(1), trust_me_else_fail, proceed]). predicate(system:nospy/1,305,static,private,monofile,built_in,[ try_me_else(1), allocate(3), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[nospy,1]), put_variable(y(0),1), put_variable(y(1),2), call('$strip_module_nonvar'/3), put_value(y(1),0), put_value(y(0),1), put_variable(y(2),2), call('$debug_list_of_pred'/3), put_value(y(2),0), call('$debug_spy_reset'/1), fail, label(1), trust_me_else_fail, proceed]). predicate(system:nospyall/0,317,static,private,monofile,built_in,[ try_me_else(1), allocate(0), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[nospyall,0]), put_structure('$debug_spy_point'/4,0), unify_void(4), put_meta_term(system,0,0), call(retractall/1), put_atom(debugger_output,0), put_atom('All spypoints removed',1), call(write/2), put_atom(debugger_output,0), call(nl/1), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$debug_spy_set'/2,329,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(8), get_list(0), unify_variable(x(0)), unify_variable(y(3)), get_structure((:)/2,0), unify_variable(y(0)), unify_structure((/)/2), unify_variable(y(1)), unify_variable(y(2)), get_variable(y(4),1), get_variable(y(5),2), put_value(y(1),0), put_value(y(2),1), put_value(y(0),2), put_variable(y(6),3), call('$$debug_spy_set/2_$aux1'/4), put_structure('$debug_spy_point'/4,0), unify_value(y(1)), unify_value(y(2)), unify_value(y(0)), unify_local_value(y(4)), put_meta_term(system,0,0), call(assertz/1), put_value(y(1),0), put_value(y(2),1), put_value(y(0),2), put_variable(y(7),3), call('$debug_qualify_pi_pretty'/4), put_atom(debugger_output,0), put_atom('~a ~q~n',1), put_list(2), unify_local_value(y(6)), unify_list, unify_local_value(y(7)), unify_nil, call(format/3), cut(y(5)), put_value(y(3),0), put_value(y(4),1), deallocate, execute('$debug_spy_set'/2)]). predicate(system:'$$debug_spy_set/2_$aux1'/4,331,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(2), get_variable(y(0),3), get_variable(y(1),4), put_structure('$debug_spy_point'/4,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), unify_void(1), put_meta_term(system,3,0), call(retract/1), cut(y(1)), put_value(y(0),0), get_atom('There is already a spypoint on',0), deallocate, proceed, label(1), trust_me_else_fail, get_atom('Spypoint placed on',3), proceed]). predicate(system:'$debug_spy_reset'/1,344,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(7), get_list(0), unify_variable(x(0)), unify_variable(y(3)), get_structure((:)/2,0), unify_variable(y(0)), unify_structure((/)/2), unify_variable(y(1)), unify_variable(y(2)), get_variable(y(4),1), put_value(y(1),0), put_value(y(2),1), put_value(y(0),2), put_variable(y(5),3), call('$$debug_spy_reset/1_$aux1'/4), put_value(y(1),0), put_value(y(2),1), put_value(y(0),2), put_variable(y(6),3), call('$debug_qualify_pi_pretty'/4), put_atom(debugger_output,0), put_atom('~a ~q~n',1), put_list(2), unify_local_value(y(5)), unify_list, unify_local_value(y(6)), unify_nil, call(format/3), cut(y(4)), put_value(y(3),0), deallocate, execute('$debug_spy_reset'/1)]). predicate(system:'$$debug_spy_reset/1_$aux1'/4,346,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(2), get_variable(y(0),3), get_variable(y(1),4), put_structure('$debug_spy_point'/4,3), unify_local_value(x(0)), unify_local_value(x(1)), unify_local_value(x(2)), unify_void(1), put_meta_term(system,3,0), call(retract/1), cut(y(1)), put_value(y(0),0), get_atom('Spypoint removed from',0), deallocate, proceed, label(1), trust_me_else_fail, get_atom('There is no spypoint on',3), proceed]). predicate(system:'$has_spy_point'/3,358,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), allocate(1), get_variable(y(0),3), put_variable(x(4),5), put_variable(x(3),6), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(5),x(6)]), put_structure('$debug_spy_point'/4,0), unify_value(x(4)), unify_value(x(3)), unify_local_value(x(1)), unify_local_value(x(2)), put_meta_term(system,0,0), put_void(1), call(clause/2), cut(y(0)), deallocate, proceed]). predicate(system:'$has_no_spy_point'/2,364,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_variable(y(0),2), put_variable(x(3),4), put_variable(x(2),5), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(4),x(5)]), put_structure('$debug_spy_point'/4,0), unify_value(x(3)), unify_value(x(2)), unify_local_value(x(1)), unify_void(1), put_meta_term(system,0,0), put_void(1), call(clause/2), cut(y(0)), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$spy_test_condition'/4,374,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), get_structure(c/3,3), unify_local_value(x(0)), unify_local_value(x(2)), unify_variable(x(0)), put_value(x(4),2), execute('$$spy_test_condition/4_$aux1'/3)]). predicate(system:'$$spy_test_condition/4_$aux1'/3,374,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), proceed, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),2), put_atom(spy_conditional,2), put_integer(1,3), call('$call_no_debug'/4), cut(y(0)), deallocate, proceed]). predicate(system:'$show_spy_points'/0,385,static,private,monofile,built_in,[ try_me_else(1), allocate(4), put_atom(debugger_output,0), put_atom('Spypoints:',1), call(write/2), put_atom(debugger_output,0), call(nl/1), put_structure('$debug_spy_point'/4,0), unify_variable(y(0)), unify_variable(y(1)), unify_variable(y(2)), unify_void(1), put_meta_term(system,0,0), put_void(1), call(clause/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_variable(y(3),3), call('$debug_qualify_pi_pretty'/4), put_atom(debugger_output,0), put_atom(' ~q~n',1), put_list(2), unify_local_value(y(3)), unify_nil, call(format/3), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$debug_list_of_pred'/3,398,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), execute('$pl_err_instantiation'/0), label(1), retry_me_else(6), switch_on_term(2,3,fail,5,fail), label(2), try_me_else(4), label(3), get_nil(0), get_nil(2), cut(x(3)), proceed, label(4), trust_me_else_fail, label(5), allocate(6), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(3),3), put_value(y(1),1), put_variable(y(4),2), call('$debug_list_of_pred_one'/3), put_value(y(0),0), put_value(y(1),1), put_variable(y(5),2), call('$debug_list_of_pred'/3), put_value(y(4),0), put_value(y(5),1), put_value(y(2),2), call(append/3), cut(y(3)), deallocate, proceed, label(6), trust_me_else_fail, execute('$debug_list_of_pred_one'/3)]). predicate(system:'$debug_list_of_pred_one'/3,414,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), execute('$pl_err_instantiation'/0), label(1), retry_me_else(2), allocate(3), get_variable(y(0),2), put_atom(:,1), put_integer(2,2), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), cut(x(3)), put_variable(y(1),1), put_variable(y(2),2), call('$strip_module_nonvar'/3), put_unsafe_value(y(2),0), put_unsafe_value(y(1),1), put_value(y(0),2), deallocate, execute('$debug_list_of_pred_one'/3), label(2), retry_me_else(8), switch_on_term(4,fail,fail,fail,3), label(3), switch_on_structure([((-)/2,5),((/)/2,7)]), label(4), try_me_else(6), label(5), get_variable(x(4),2), get_variable(x(5),1), get_structure((-)/2,0), unify_variable(x(0)), unify_variable(x(2)), get_structure((/)/2,0), unify_variable(x(0)), unify_variable(x(1)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(3)), put_value(x(5),3), execute('$debug_list_of_pred_one1'/5), label(6), trust_me_else_fail, label(7), get_variable(x(4),2), get_variable(x(5),1), get_structure((/)/2,0), unify_variable(x(0)), unify_structure((-)/2), unify_variable(x(1)), unify_variable(x(2)), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(3)), put_value(x(5),3), execute('$debug_list_of_pred_one1'/5), label(8), retry_me_else(9), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(0),0), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), cut(x(3)), put_atom(max_arity,0), put_variable(y(3),1), call(current_prolog_flag/2), put_value(y(0),0), put_integer(0,1), put_unsafe_value(y(3),2), put_value(y(1),3), put_value(y(2),4), deallocate, execute('$debug_list_of_pred_one1'/5), label(9), trust_me_else_fail, allocate(4), get_variable(y(0),2), put_variable(y(1),2), put_variable(y(2),3), put_variable(y(3),4), call('$get_pred_indic'/5), put_unsafe_value(y(2),0), put_unsafe_value(y(3),1), put_unsafe_value(y(3),2), put_unsafe_value(y(1),3), put_value(y(0),4), deallocate, execute('$debug_list_of_pred_one1'/5)]). predicate(system:'$debug_list_of_pred_one1'/5,443,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(5)), execute('$pl_err_instantiation'/0), label(1), retry_me_else(2), call_c('Pl_Blt_Var',[fast_call,boolean],[x(1)]), cut(x(5)), execute('$pl_err_instantiation'/0), label(2), retry_me_else(3), call_c('Pl_Blt_Var',[fast_call,boolean],[x(2)]), cut(x(5)), execute('$pl_err_instantiation'/0), label(3), trust_me_else_fail, allocate(6), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_atom(max_arity,0), put_variable(y(5),1), call(current_prolog_flag/2), put_value(y(1),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), put_value(y(2),0), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), math_fast_load_value(y(1),0), put_integer(0,1), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(1),0), math_fast_load_value(y(5),1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(2),0), put_integer(0,1), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(2),0), math_fast_load_value(y(5),1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), put_atom('$debug_work',0), put_nil(1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(3),0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), put_value(y(4),4), call('$$debug_list_of_pred_one1/5_$aux1'/5), put_value(y(4),0), put_value(y(1),1), put_value(y(2),2), put_value(y(0),3), put_unsafe_value(y(5),4), put_value(y(3),5), deallocate, execute('$$debug_list_of_pred_one1/5_$aux2'/6)]). predicate(system:'$$debug_list_of_pred_one1/5_$aux2'/6,455,static,private,monofile,local,[ try_me_else(1), allocate(3), get_variable(y(0),5), get_nil(0), put_value(x(1),0), put_value(x(2),1), put_variable(y(1),2), call('$$debug_list_of_pred_one1/5_$aux3'/5), put_value(y(0),0), put_variable(y(2),1), put_value(y(1),2), call('$$debug_list_of_pred_one1/5_$aux4'/3), put_atom(debugger_output,0), put_atom('Warning: spy ~q - no matching predicate~n',1), put_list(2), unify_local_value(y(2)), unify_nil, call(format/3), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$$debug_list_of_pred_one1/5_$aux4'/3,455,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), get_value(x(2),1), proceed, label(1), trust_me_else_fail, get_structure((:)/2,1), unify_local_value(x(0)), unify_local_value(x(2)), proceed]). predicate(system:'$$debug_list_of_pred_one1/5_$aux3'/5,455,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_value(x(1),0), cut(x(5)), get_structure((/)/2,2), unify_local_value(x(3)), unify_local_value(x(0)), proceed, label(1), retry_me_else(2), get_integer(0,0), cut(x(5)), get_value(x(4),1), get_structure((/)/2,2), unify_local_value(x(3)), unify_atom(any), proceed, label(2), trust_me_else_fail, get_structure((-)/2,2), unify_variable(x(2)), unify_local_value(x(1)), get_structure((/)/2,2), unify_local_value(x(3)), unify_local_value(x(0)), proceed]). predicate(system:'$$debug_list_of_pred_one1/5_$aux1'/5,455,static,private,monofile,local,[ try_me_else(1), allocate(7), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_structure((:)/2,0), unify_local_value(y(0)), unify_structure((/)/2), unify_local_value(y(1)), unify_variable(y(4)), put_meta_term(system,0,0), call('$current_predicate_any'/1), math_fast_load_value(y(4),0), math_fast_load_value(y(2),1), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(4),0), math_fast_load_value(y(3),1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), put_atom('$debug_work',0), put_variable(y(5),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_value(y(4),2), put_variable(y(6),3), call('$get_module_of_pred'/4), put_atom('$debug_work',0), put_structure((:)/2,2), unify_local_value(y(6)), unify_structure((/)/2), unify_local_value(y(1)), unify_value(y(4)), put_list(1), unify_value(x(2)), unify_local_value(y(5)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), fail, label(1), trust_me_else_fail, put_atom('$debug_work',0), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(4)]), proceed]). predicate(system:'$debug_call'/3,502,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(23), switch_on_term(3,1,fail,fail,2), label(1), switch_on_atom([(notrace,4),(nodebug,6),(trace,8),(debug,10),(debugging,12),(nospyall,22)]), label(2), switch_on_structure([(leash/1,14),(spy/1,16),(spypoint_condition/3,18),(nospy/1,20)]), label(3), try_me_else(5), label(4), get_atom(notrace,0), cut(x(3)), execute(notrace/0), label(5), retry_me_else(7), label(6), get_atom(nodebug,0), cut(x(3)), execute(nodebug/0), label(7), retry_me_else(9), label(8), get_atom(trace,0), cut(x(3)), execute(trace/0), label(9), retry_me_else(11), label(10), get_atom(debug,0), cut(x(3)), execute(debug/0), label(11), retry_me_else(13), label(12), get_atom(debugging,0), cut(x(3)), execute(debugging/0), label(13), retry_me_else(15), label(14), get_structure(leash/1,0), unify_variable(x(0)), cut(x(3)), execute(leash/1), label(15), retry_me_else(17), label(16), get_structure(spy/1,0), unify_variable(x(2)), cut(x(3)), put_structure((:)/2,0), unify_local_value(x(1)), unify_value(x(2)), put_meta_term(system,0,0), execute(spy/1), label(17), retry_me_else(19), label(18), get_variable(x(5),1), get_structure(spypoint_condition/3,0), unify_variable(x(4)), unify_variable(x(1)), unify_variable(x(2)), cut(x(3)), put_structure((:)/2,0), unify_local_value(x(5)), unify_value(x(4)), put_meta_term(system,0,0), execute(spypoint_condition/3), label(19), retry_me_else(21), label(20), get_structure(nospy/1,0), unify_variable(x(2)), cut(x(3)), put_structure((:)/2,0), unify_local_value(x(1)), unify_value(x(2)), put_meta_term(system,0,0), execute(nospy/1), label(21), trust_me_else_fail, label(22), get_atom(nospyall,0), cut(x(3)), execute(nospyall/0), label(23), trust_me_else_fail, allocate(11), get_variable(y(0),0), get_variable(y(1),2), put_value(x(1),0), put_value(y(0),1), put_variable(y(2),2), call('$$debug_call/3_$aux1'/3), put_atom('$debug_info',0), put_variable(y(3),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(3),0), get_structure(d/2,0), unify_variable(y(4)), unify_variable(y(5)), put_value(y(5),0), put_variable(y(6),1), call('$$debug_call/3_$aux2'/2), math_fast_load_value(y(4),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_variable(y(7),0), math_fast_load_value(y(6),0), call_c('Pl_Fct_Fast_Inc',[fast_call,x(0)],[x(0)]), get_variable(y(8),0), put_variable(y(9),0), call('$get_current_B'/1), put_variable(y(10),0), get_list(0), unify_variable(x(0)), unify_value(y(5)), get_structure(a/5,0), unify_local_value(y(0)), unify_local_value(y(2)), unify_local_value(y(7)), unify_local_value(y(8)), unify_local_value(y(9)), put_integer(1,0), put_value(y(3),1), put_value(y(7),2), call(setarg/3), put_integer(2,0), put_value(y(3),1), put_value(y(10),2), call(setarg/3), put_value(y(0),0), put_unsafe_value(y(2),1), put_value(y(1),2), put_unsafe_value(y(7),3), put_unsafe_value(y(8),4), put_unsafe_value(y(10),5), put_unsafe_value(y(3),6), put_value(y(4),7), put_value(y(5),8), deallocate, execute('$debug_call1'/9)]). predicate(system:'$$debug_call/3_$aux2'/2,543,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), cut(x(2)), get_integer(0,1), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(0)), unify_void(1), get_structure(a/5,0), unify_void(3), unify_local_value(x(1)), unify_void(1), proceed]). predicate(system:'$$debug_call/3_$aux1'/3,543,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(1), get_variable(y(0),3), call('$get_module_of_goal_if_not_meta_pred'/3), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(0),2), proceed]). predicate(system:'$debug_call1'/9,570,static,private,monofile,built_in,[ pragma_arity(10), get_current_choice(x(9)), try_me_else(1), allocate(11), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), get_variable(y(7),8), get_variable(y(8),9), put_variable(y(9),0), call('$get_current_B'/1), put_structure('$debug_exception_port'/6,2), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(y(3)), unify_local_value(y(4)), unify_local_value(y(5)), unify_variable(x(1)), put_structure('$debug_call_port'/6,0), unify_local_value(y(0)), unify_local_value(y(1)), unify_local_value(y(2)), unify_local_value(y(3)), unify_local_value(y(4)), unify_local_value(y(5)), put_atom(system,3), put_integer(0,4), call('$catch_internal'/5), put_variable(y(10),0), call('$get_current_B'/1), put_value(y(0),0), put_value(y(1),1), put_value(y(3),2), put_value(y(4),3), put_value(y(5),4), put_value(y(6),5), put_value(y(7),6), call('$debug_end_call'/7), put_unsafe_value(y(10),0), put_unsafe_value(y(9),1), put_unsafe_value(y(8),2), deallocate, execute('$$debug_call1/9_$aux1'/3), label(1), retry_me_else(2), allocate(0), put_value(x(3),2), put_value(x(4),3), put_value(x(5),4), put_atom(fail,5), call('$debug_port'/6), fail, label(2), trust_me_else_fail, allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),6), get_variable(y(4),8), put_atom('$debug_next',1), put_structure(retry/1,2), unify_variable(x(0)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), math_fast_load_value(x(0),0), math_fast_load_value(x(3),1), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(0),x(1)]), put_value(x(7),2), put_integer(1,0), put_value(y(3),1), call(setarg/3), put_integer(2,0), put_value(y(3),1), put_value(y(4),2), call(setarg/3), put_atom('$debug_next',0), put_atom(trace,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute('$debug_call'/3)]). predicate(system:'$$debug_call1/9_$aux1'/3,570,static,private,monofile,local,[ try_me_else(1), math_fast_load_value(x(0),0), math_fast_load_value(x(1),1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), cut(x(2)), proceed, label(1), trust_me_else_fail, proceed]). predicate(system:'$debug_call_port'/6,601,static,private,monofile,built_in,[ allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_atom('$debug_unify',0), put_atom('',1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(x(3),2), put_value(x(4),3), put_value(x(5),4), put_value(y(0),0), put_value(y(1),1), put_atom(call,5), call('$debug_port'/6), put_atom('$debug_unify',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), deallocate, execute('$$debug_call_port/6_$aux1'/4)]). predicate(system:'$$debug_call_port/6_$aux1'/4,601,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), put_atom('',5), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(0),x(5)]), cut(x(4)), put_atom(fail,0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(1),x(0)]), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), execute('$call_from_debugger'/3), label(1), trust_me_else_fail, get_value(x(0),1), proceed]). predicate(system:'$debug_end_call'/7,619,static,private,monofile,built_in,[ try_me_else(1), allocate(2), get_variable(y(0),5), get_variable(y(1),6), put_atom(exit,5), call('$debug_port'/6), put_integer(2,0), put_value(y(0),1), put_value(y(1),2), deallocate, execute(setarg/3), label(1), trust_me_else_fail, allocate(0), put_atom(redo,5), call('$debug_port'/6), fail]). predicate(system:'$debug_exception_port'/6,631,static,private,monofile,built_in,[ allocate(1), get_variable(y(0),5), put_atom('$debug_ball',5), put_value(y(0),6), call_c('Pl_Blt_G_Assign',[fast_call],[x(5),x(6)]), put_atom(exception,5), call('$debug_port'/6), put_value(y(0),0), put_atom(system,1), put_atom('$debug_exception_port',2), put_integer(6,3), deallocate, execute('$throw'/4)]). predicate(system:'$debug_port'/6,641,static,private,monofile,built_in,[ allocate(7), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), put_variable(y(6),0), call('$get_current_B'/1), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), put_unsafe_value(y(6),6), deallocate, execute('$debug_port1'/7)]). predicate(system:'$debug_port1'/7,646,static,private,monofile,built_in,[ try_me_else(1), allocate(0), call('$debug_port2'/7), fail, label(1), trust_me_else_fail, put_atom('$debug_next',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), proceed]). predicate(system:'$debug_port2'/7,658,static,private,monofile,built_in,[ pragma_arity(8), get_current_choice(x(7)), try_me_else(1), allocate(1), get_variable(x(3),2), get_variable(x(2),1), get_variable(x(1),0), get_variable(y(0),7), put_atom('$debug_next',4), put_variable(x(0),6), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(4),x(6)]), put_value(x(5),4), call('$debug_port_ignore'/5), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, execute('$debug_port_prompt'/7)]). predicate(system:'$debug_port_ignore'/5,669,static,private,monofile,built_in,[ pragma_arity(6), get_current_choice(x(5)), switch_on_term(4,1,fail,fail,3), label(1), switch_on_atom([(nodebug,5),(debug,2),(skip,11)]), label(2), try(7), trust(9), label(3), switch_on_structure([(fail/1,13),(retry/1,15)]), label(4), try_me_else(6), label(5), get_atom(nodebug,0), proceed, label(6), retry_me_else(8), label(7), get_atom(debug,0), put_value(x(1),0), put_value(x(2),1), execute('$has_no_spy_point'/2), label(8), retry_me_else(10), label(9), allocate(4), get_atom(debug,0), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),4), put_value(y(0),0), put_value(y(1),1), put_variable(y(3),2), call('$has_spy_point'/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_unsafe_value(y(3),3), deallocate, execute('$$debug_port_ignore/5_$aux1'/4), label(10), retry_me_else(12), label(11), allocate(5), get_atom(skip,0), get_variable(y(0),3), get_variable(y(1),5), put_atom('$debug_skip',0), put_structure(s/2,1), unify_variable(y(2)), unify_variable(y(3)), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(x(4),0), put_variable(y(4),1), call('$debug_port_mask'/2), put_value(y(0),0), put_value(y(2),1), put_unsafe_value(y(4),2), put_value(y(3),3), put_unsafe_value(y(1),4), deallocate, execute('$$debug_port_ignore/5_$aux2'/5), label(12), retry_me_else(14), label(13), allocate(1), get_structure(fail/1,0), unify_variable(x(1)), get_variable(y(0),5), put_value(x(3),0), put_value(x(4),2), call('$$debug_port_ignore/5_$aux3'/3), cut(y(0)), deallocate, proceed, label(14), trust_me_else_fail, label(15), get_structure(retry/1,0), unify_void(1), proceed]). predicate(system:'$$debug_port_ignore/5_$aux3'/3,691,static,private,monofile,local,[ try_me_else(1), math_fast_load_value(x(0),0), math_fast_load_value(x(1),1), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(1)]), proceed, label(1), trust_me_else_fail, put_atom(fail,0), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(2),x(0)]), proceed]). predicate(system:'$$debug_port_ignore/5_$aux2'/5,682,static,private,monofile,local,[ pragma_arity(6), get_current_choice(x(5)), try_me_else(1), get_value(x(1),0), math_fast_load_value(x(2),0), math_fast_load_value(x(3),1), call_c('Pl_Fct_Fast_And',[fast_call,x(0)],[x(0),x(1)]), put_integer(0,1), call_c('Pl_Blt_Fast_Gt',[fast_call,boolean],[x(0),x(1)]), cut(x(5)), fail, label(1), trust_me_else_fail, cut(x(4)), proceed]). predicate(system:'$$debug_port_ignore/5_$aux1'/4,674,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(1), get_variable(y(0),4), call('$spy_test_condition'/4), cut(y(0)), fail, label(1), trust_me_else_fail, proceed]). predicate(system:'$debug_port_prompt'/7,701,static,private,monofile,built_in,[ pragma_arity(8), get_current_choice(x(7)), allocate(8), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), get_variable(y(6),6), get_variable(y(7),7), call(repeat/0), put_atom('$debug_next',0), put_atom(trace,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(5),4), call('$debug_write_goal'/5), put_value(y(0),0), put_value(y(1),1), put_value(y(5),2), put_value(y(2),3), put_value(y(4),4), put_value(y(6),5), call('$$debug_port_prompt/7_$aux1'/6), cut(y(7)), deallocate, proceed]). predicate(system:'$$debug_port_prompt/7_$aux1'/6,701,static,private,monofile,local,[ pragma_arity(7), get_current_choice(x(6)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(y(1),6), call('$has_no_spy_point'/2), put_value(y(0),0), call('$debug_is_not_leashed'/1), cut(y(1)), put_atom(debugger_output,0), deallocate, execute(nl/1), label(1), trust_me_else_fail, allocate(7), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), get_variable(y(5),5), put_variable(y(6),0), call('$debug_read_cmd'/1), put_unsafe_value(y(6),0), put_value(y(0),1), put_value(y(1),2), put_value(y(3),3), put_value(y(4),4), put_value(y(2),5), put_value(y(5),6), deallocate, execute('$debug_exec_cmd'/7)]). predicate(system:'$debug_read_cmd'/1,715,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), put_atom(debugger_output,0), put_atom(' ? ',1), call(write/2), put_atom(debugger_output,0), call(flush_output/1), put_atom(debugger_input,0), put_variable(y(1),1), call(get_key/2), math_fast_load_value(y(1),0), put_integer(0,1), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(1),0), put_integer(255,1), call_c('Pl_Blt_Fast_Lt',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), call(char_code/2), put_atom(debugger_output,0), put_atom('~N',1), put_nil(2), deallocate, execute(format/3)]). predicate(system:'$debug_read_integer'/1,727,static,private,monofile,built_in,[ pragma_arity(2), get_current_choice(x(1)), allocate(1), get_variable(y(0),1), put_value(x(0),1), put_atom(debugger_input,0), call(read_integer/2), call(repeat/0), put_atom(debugger_input,0), put_integer(10,1), call(get_code/2), cut(y(0)), deallocate, proceed]). predicate(system:'$debug_exec_cmd'/7,735,static,private,monofile,built_in,[ pragma_arity(8), get_current_choice(x(7)), try_me_else(1), allocate(7), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_variable(y(5),6), put_variable(y(6),1), call(char_code/2), math_fast_load_value(y(6),0), put_integer(10,1), call_c('Pl_Blt_Fast_Gte',[fast_call,boolean],[x(0),x(1)]), math_fast_load_value(y(6),0), put_integer(13,1), call_c('Pl_Blt_Fast_Lte',[fast_call,boolean],[x(0),x(1)]), put_atom(c,0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), put_value(y(3),4), put_value(y(4),5), put_value(y(5),6), deallocate, execute('$debug_exec_cmd'/7), label(1), retry_me_else(66), switch_on_term(6,2,fail,fail,fail), label(2), switch_on_atom([(c,7),(l,9),(s,3),('G',15),(r,4),(f,5),(w,25),(d,27),(p,29),(e,31),(g,33),('A',35),(u,37),(n,39),((=),41),('.',43),((+),45),((*),47),((-),49),('L',51),(a,53),(b,55),(@,57),((<),59),((?),61),(h,63),('W',65)]), label(3), try(11), trust(13), label(4), try(17), trust(19), label(5), try(21), trust(23), label(6), try_me_else(8), label(7), get_atom(c,0), put_atom('$debug_next',0), put_atom(trace,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(8), retry_me_else(10), label(9), get_atom(l,0), put_atom('$debug_next',0), put_atom(debug,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(10), retry_me_else(12), label(11), allocate(7), get_atom(s,0), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), get_variable(y(3),4), get_variable(y(4),5), get_variable(y(5),6), get_variable(y(6),7), put_value(y(4),0), call('$$debug_exec_cmd/7_$aux1'/1), cut(y(6)), put_atom(c,0), put_value(y(0),1), put_value(y(1),2), put_value(y(2),3), put_value(y(3),4), put_value(y(4),5), put_value(y(5),6), deallocate, execute('$debug_exec_cmd'/7), label(12), retry_me_else(14), label(13), allocate(4), get_atom(s,0), get_variable(y(0),3), put_atom('$debug_next',0), put_atom(skip,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom(exit,0), put_variable(y(1),1), call('$debug_port_mask'/2), put_atom(fail,0), put_variable(y(2),1), call('$debug_port_mask'/2), put_atom(exception,0), put_variable(y(3),1), call('$debug_port_mask'/2), math_fast_load_value(y(1),0), math_fast_load_value(y(2),1), call_c('Pl_Fct_Fast_Or',[fast_call,x(0)],[x(0),x(1)]), math_fast_load_value(y(3),1), call_c('Pl_Fct_Fast_Or',[fast_call,x(2)],[x(0),x(1)]), put_atom('$debug_skip',0), put_structure(s/2,1), unify_local_value(y(0)), unify_local_value(x(2)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(14), retry_me_else(16), label(15), allocate(1), get_atom('G',0), put_atom(debugger_output,0), put_atom('Inovcation nb: ',1), call(write/2), put_variable(y(0),0), call('$debug_read_integer'/1), put_atom('$debug_next',0), put_atom(skip,1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), put_atom('$debug_skip',0), put_structure(s/2,1), unify_local_value(y(0)), unify_integer(31), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(16), retry_me_else(18), label(17), get_atom(r,0), get_atom(call,5), cut(x(7)), fail, label(18), retry_me_else(20), label(19), get_atom(r,0), put_atom('$debug_next',0), put_structure(retry/1,1), unify_local_value(x(3)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(20), retry_me_else(22), label(21), get_atom(f,0), get_atom(fail,5), cut(x(7)), fail, label(22), retry_me_else(24), label(23), get_atom(f,0), put_atom('$debug_next',0), put_structure(fail/1,1), unify_local_value(x(3)), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), proceed, label(24), retry_me_else(26), label(25), allocate(2), get_atom(w,0), get_variable(y(0),7), put_value(x(1),0), put_value(x(2),1), put_variable(y(1),2), call('$debug_qualify_goal_pretty'/3), put_atom(debugger_output,0), put_atom(' ',1), call(write/2), put_atom(debugger_output,0), put_value(y(1),1), call(write/2), put_atom(debugger_output,0), call(nl/1), cut(y(0)), fail, label(26), retry_me_else(28), label(27), allocate(2), get_atom(d,0), get_variable(y(0),7), put_value(x(1),0), put_value(x(2),1), put_variable(y(1),2), call('$debug_qualify_goal_pretty'/3), put_atom(debugger_output,0), put_atom(' ',1), call(write/2), put_atom(debugger_output,0), put_value(y(1),1), call(display/2), put_atom(debugger_output,0), call(nl/1), cut(y(0)), fail, label(28), retry_me_else(30), label(29), allocate(2), get_atom(p,0), get_variable(y(0),7), put_value(x(1),0), put_value(x(2),1), put_variable(y(1),2), call('$debug_qualify_goal_pretty'/3), put_atom(debugger_output,0), put_atom(' ',1), call(write/2), put_atom(debugger_output,0), put_value(y(1),1), call(print/2), put_atom(debugger_output,0), call(nl/1), cut(y(0)), fail, label(30), retry_me_else(32), label(31), allocate(1), get_atom(e,0), get_variable(y(0),7), put_value(x(5),0), call('$$debug_exec_cmd/7_$aux2'/1), cut(y(0)), fail, label(32), retry_me_else(34), label(33), allocate(1), get_atom(g,0), get_variable(y(0),7), put_value(x(4),0), call('$debug_disp_anc_lst'/1), cut(y(0)), fail, label(34), retry_me_else(36), label(35), allocate(1), get_atom('A',0), get_variable(y(0),7), put_value(x(4),0), put_value(x(6),1), call('$debug_disp_alternatives'/2), cut(y(0)), fail, label(36), retry_me_else(38), label(37), get_atom(u,0), put_value(x(5),0), put_value(x(7),1), execute('$$debug_exec_cmd/7_$aux3'/2), label(38), retry_me_else(40), label(39), get_atom(n,0), execute('$debug_switch_off'/0), label(40), retry_me_else(42), label(41), allocate(1), get_atom(=,0), get_variable(y(0),7), call(debugging/0), cut(y(0)), fail, label(42), retry_me_else(44), label(43), allocate(0), get_atom('.',0), get_variable(x(0),2), get_variable(x(3),1), cut(x(7)), put_variable(x(1),4), put_variable(x(2),5), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(3),x(4),x(5)]), call('$$debug_exec_cmd/7_$aux4'/3), fail, label(44), retry_me_else(46), label(45), allocate(1), get_atom(+,0), get_variable(y(0),7), put_variable(x(4),0), put_variable(x(3),5), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(0),x(5)]), put_structure((:)/2,0), unify_local_value(x(2)), unify_structure((/)/2), unify_value(x(4)), unify_value(x(3)), put_meta_term(system,0,0), call(spy/1), cut(y(0)), fail, label(46), retry_me_else(48), label(47), allocate(6), get_atom(*,0), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),7), call(repeat/0), put_atom(debugger_output,0), put_atom('Goal,Port,Test: ',1), call(write/2), put_atom(debugger_input,0), put_structure((',')/2,1), unify_variable(y(3)), unify_structure((',')/2), unify_variable(y(4)), unify_variable(y(5)), call(read/2), put_value(y(3),0), call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), put_value(y(0),0), put_variable(x(1),3), put_variable(x(2),4), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(3),x(4)]), put_value(y(3),0), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(0),x(1),x(2)]), put_structure((:)/2,0), unify_local_value(y(1)), unify_value(y(3)), put_meta_term(system,0,0), put_value(y(4),1), put_value(y(5),2), call(spypoint_condition/3), cut(y(2)), fail, label(48), retry_me_else(50), label(49), allocate(1), get_atom(-,0), get_variable(y(0),7), put_variable(x(4),0), put_variable(x(3),5), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(0),x(5)]), put_structure((:)/2,0), unify_local_value(x(2)), unify_structure((/)/2), unify_value(x(4)), unify_value(x(3)), put_meta_term(system,0,0), call(nospy/1), cut(y(0)), fail, label(50), retry_me_else(52), label(51), allocate(0), get_atom('L',0), get_variable(x(4),2), cut(x(7)), put_variable(x(2),0), put_variable(x(3),5), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(0),x(5)]), put_structure((:)/2,0), unify_local_value(x(4)), unify_structure((/)/2), unify_value(x(2)), unify_value(x(3)), put_value(x(4),1), call('$$debug_exec_cmd/7_$aux5'/4), fail, label(52), retry_me_else(54), label(53), get_atom(a,0), execute(abort/0), label(54), retry_me_else(56), label(55), allocate(1), get_atom(b,0), get_variable(y(0),7), call(break/0), cut(y(0)), fail, label(56), retry_me_else(58), label(57), allocate(2), get_atom(@,0), get_variable(y(0),7), put_atom(debugger_output,0), put_atom('Command: ',1), call(write/2), put_atom(debugger_input,0), put_variable(y(1),1), call(read/2), put_value(y(1),0), call('$$debug_exec_cmd/7_$aux6'/1), cut(y(0)), fail, label(58), retry_me_else(60), label(59), allocate(2), get_atom(<,0), get_variable(y(0),7), put_atom(debugger_output,0), put_atom('Print Depth: ',1), call(write/2), put_variable(y(1),0), call('$debug_read_integer'/1), put_atom('$debug_depth',0), put_unsafe_value(y(1),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), cut(y(0)), fail, label(60), retry_me_else(62), label(61), allocate(1), get_atom(?,0), get_variable(y(0),7), call('$debug_disp_help'/0), cut(y(0)), fail, label(62), retry_me_else(64), label(63), allocate(1), get_atom(h,0), get_variable(y(0),7), call('$debug_disp_help'/0), cut(y(0)), fail, label(64), trust_me_else_fail, label(65), allocate(1), get_atom('W',0), get_variable(y(0),7), call(wam_debug/0), cut(y(0)), fail, label(66), trust_me_else_fail, allocate(0), put_atom(debugger_output,0), put_atom('Unknown command (type h for help)',1), call(write/2), put_atom(debugger_output,0), call(nl/1), fail]). predicate(system:'$$debug_exec_cmd/7_$aux6'/1,891,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), allocate(1), get_variable(y(0),1), put_structure(format/3,2), unify_atom(debugger_output), unify_atom('Warning: ~q - exception raised ~w~n'), unify_list, unify_local_value(x(0)), unify_list, unify_variable(x(1)), unify_nil, put_atom(user,3), put_atom(debugger_exec_cmd,4), put_integer(1,5), call('$catch_no_debug'/6), cut(y(0)), deallocate, proceed, label(1), trust_me_else_fail, put_list(2), unify_local_value(x(0)), unify_nil, put_atom(debugger_output,0), put_atom('Warning: ~q - goal failed~n',1), execute(format/3)]). predicate(system:'$$debug_exec_cmd/7_$aux5'/4,867,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_value(y(0),0), put_meta_term(system,0,0), call('$current_predicate_any'/1), cut(y(4)), put_value(y(1),0), put_value(y(2),1), put_value(y(3),2), put_value(y(0),3), deallocate, execute('$$debug_exec_cmd/7_$aux7'/4), label(1), trust_me_else_fail, get_variable(x(0),2), put_list(2), unify_local_value(x(0)), unify_list, unify_local_value(x(3)), unify_nil, put_atom(debugger_output,0), put_atom('cannot find any info on ~a/~d~n',1), execute(format/3)]). predicate(system:'$$debug_exec_cmd/7_$aux7'/4,867,static,private,monofile,local,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(3), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),4), put_value(y(0),1), put_value(y(1),2), put_atom(native_code,3), call('$predicate_property1'/4), cut(y(2)), put_atom(debugger_output,0), put_atom('native code predicate ~a/~d~n',1), put_list(2), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_nil, deallocate, execute(format/3), label(1), trust_me_else_fail, allocate(0), call_c('Pl_Reset_Debug_Call_Code_0',[],[]), put_meta_term(system,3,0), call(listing/1), put_atom(debugger_output,0), call(nl/1), deallocate, call_c('Pl_Set_Debug_Call_Code_0',[],[]), proceed]). predicate(system:'$$debug_exec_cmd/7_$aux4'/3,837,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(5), get_variable(y(0),1), get_variable(y(1),2), get_variable(y(2),3), put_value(y(0),1), put_value(y(1),2), put_variable(y(3),3), put_variable(y(4),4), call('$get_predicate_file_info'/5), cut(y(2)), put_atom(debugger_output,0), put_atom('~a/~d defined in ~a:~d~n',1), put_list(2), unify_local_value(y(0)), unify_list, unify_local_value(y(1)), unify_list, unify_local_value(y(3)), unify_list, unify_local_value(y(4)), unify_nil, deallocate, execute(format/3), label(1), trust_me_else_fail, get_variable(x(0),2), put_list(2), unify_local_value(x(1)), unify_list, unify_local_value(x(0)), unify_nil, put_atom(debugger_output,0), put_atom('no file information for ~a/~d~n',1), execute(format/3)]). predicate(system:'$$debug_exec_cmd/7_$aux3'/2,820,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(1), get_atom(call,0), cut(x(2)), put_atom(debugger_output,0), put_atom('Head: ',1), call(write/2), put_atom(debugger_input,0), put_variable(y(0),1), call(read/2), put_atom('$debug_unify',0), put_unsafe_value(y(0),1), call_c('Pl_Blt_G_Assign',[fast_call],[x(0),x(1)]), deallocate, proceed, label(1), trust_me_else_fail, allocate(1), get_variable(y(0),1), put_atom(debugger_output,0), put_atom('Option not applicable at this port',1), call(write/2), put_atom(debugger_output,0), call(nl/1), cut(y(0)), fail]). predicate(system:'$$debug_exec_cmd/7_$aux2'/1,803,static,private,monofile,local,[ pragma_arity(2), get_current_choice(x(1)), try_me_else(1), get_atom(exception,0), cut(x(1)), put_atom('$debug_ball',1), put_variable(x(0),2), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(1),x(2)]), put_list(2), unify_value(x(0)), unify_nil, put_atom(debugger_output,0), put_atom('Exception raised: ~q~n',1), execute(format/3), label(1), trust_me_else_fail, allocate(0), put_atom(debugger_output,0), put_atom('Option not applicable at this port',1), call(write/2), put_atom(debugger_output,0), deallocate, execute(nl/1)]). predicate(system:'$$debug_exec_cmd/7_$aux1'/1,747,static,private,monofile,local,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(exit,3),(fail,5),(exception,7)]), label(2), try_me_else(4), label(3), get_atom(exit,0), proceed, label(4), retry_me_else(6), label(5), get_atom(fail,0), proceed, label(6), trust_me_else_fail, label(7), get_atom(exception,0), proceed]). predicate(system:'$debug_write_goal'/5,927,static,private,monofile,built_in,[ allocate(9), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_atom('$debug_depth',0), put_variable(y(5),1), call_c('Pl_Blt_G_Read',[fast_call,boolean],[x(0),x(1)]), put_value(y(0),0), put_value(y(1),1), put_variable(y(6),2), call('$$debug_write_goal/5_$aux1'/3), put_value(y(4),0), put_variable(y(7),1), call('$debug_port_pretty'/2), put_atom(debugger_output,0), put_atom('~N ~a %4d %4d ~a',1), put_list(2), unify_local_value(y(6)), unify_list, unify_local_value(y(2)), unify_list, unify_local_value(y(3)), unify_list, unify_local_value(y(7)), unify_nil, call(format/3), put_value(y(0),0), put_value(y(1),1), put_variable(y(8),2), call('$debug_qualify_goal_pretty'/3), put_atom(debugger_output,0), put_unsafe_value(y(8),1), put_structure(quoted/1,4), unify_atom(true), put_structure(max_depth/1,3), unify_local_value(y(5)), put_list(2), unify_value(x(4)), unify_list, unify_value(x(3)), unify_nil, deallocate, execute(write_term/3)]). predicate(system:'$$debug_write_goal/5_$aux1'/3,927,static,private,monofile,local,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(2), get_variable(y(0),2), get_variable(y(1),3), call('$has_no_spy_point'/2), cut(y(1)), put_value(y(0),0), get_atom(' ',0), deallocate, proceed, label(1), trust_me_else_fail, get_atom(+,2), proceed]). predicate(system:'$debug_qualify_pi_pretty'/4,940,static,private,monofile,built_in,[ pragma_arity(5), get_current_choice(x(4)), try_me_else(1), allocate(5), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), get_variable(y(4),4), put_value(y(2),0), call('$debug_needs_module'/1), cut(y(4)), put_value(y(3),0), get_structure((:)/2,0), unify_local_value(y(2)), unify_structure((/)/2), unify_local_value(y(0)), unify_local_value(y(1)), deallocate, proceed, label(1), trust_me_else_fail, get_structure((/)/2,3), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(system:'$debug_qualify_goal_pretty'/3,951,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), allocate(4), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), get_variable(y(3),3), put_value(y(1),0), call('$debug_needs_module'/1), cut(y(3)), put_value(y(2),0), get_structure((:)/2,0), unify_local_value(y(1)), unify_local_value(y(0)), deallocate, proceed, label(1), trust_me_else_fail, get_value(x(2),0), proceed]). predicate(system:'$debug_needs_module'/1,960,static,private,monofile,built_in,[ put_atom(user,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), put_atom(system,1), call_c('Pl_Blt_Term_Neq',[fast_call,boolean],[x(0),x(1)]), proceed]). predicate(system:'$debug_port_pretty'/2,967,static,private,monofile,built_in,[ switch_on_term(2,1,fail,fail,fail), label(1), switch_on_atom([(call,3),(redo,5),(fail,7),(exit,9),(exception,11),(no_port,13)]), label(2), try_me_else(4), label(3), get_atom(call,0), get_atom('Call: ',1), proceed, label(4), retry_me_else(6), label(5), get_atom(redo,0), get_atom('Redo: ',1), proceed, label(6), retry_me_else(8), label(7), get_atom(fail,0), get_atom('Fail: ',1), proceed, label(8), retry_me_else(10), label(9), get_atom(exit,0), get_atom('Exit: ',1), proceed, label(10), retry_me_else(12), label(11), get_atom(exception,0), get_atom('Exception: ',1), proceed, label(12), trust_me_else_fail, label(13), get_atom(no_port,0), get_atom('',1), proceed]). predicate(system:'$debug_disp_anc_lst'/1,982,static,private,monofile,built_in,[ allocate(1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_structure(a/5,0), unify_void(5), put_atom(debugger_output,0), put_atom('Ancestors:',1), call(write/2), put_atom(debugger_output,0), call(nl/1), put_value(y(0),0), deallocate, execute('$debug_disp_anc_lst1'/1)]). predicate(system:'$debug_disp_anc_lst1'/1,988,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_structure(a/5,1), unify_variable(y(0)), unify_variable(y(1)), unify_variable(y(2)), unify_variable(y(3)), unify_void(1), call('$debug_disp_anc_lst1'/1), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_atom(no_port,4), deallocate, execute('$debug_write_goal'/5)]). predicate(system:'$debug_disp_alternatives'/2,997,static,private,monofile,built_in,[ allocate(2), get_variable(y(0),0), get_variable(y(1),1), put_atom(debugger_output,0), put_atom('Alternatives:',1), call(write/2), put_atom(debugger_output,0), call(nl/1), put_value(y(0),0), put_value(y(1),1), call('$debug_disp_alternatives1'/2), put_atom(debugger_output,0), put_atom('~N--------------~n',1), put_nil(2), deallocate, execute(format/3)]). predicate(system:'$debug_disp_alternatives1'/2,1004,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(6), get_variable(y(5),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_structure(a/5,1), unify_variable(y(0)), unify_variable(y(1)), unify_variable(y(2)), unify_variable(y(3)), unify_variable(y(4)), put_value(y(4),1), call('$debug_disp_alternatives1'/2), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_atom(no_port,4), call('$debug_write_goal'/5), put_value(y(5),0), put_value(y(4),1), deallocate, execute('$debug_disp_alt'/2)]). predicate(system:'$debug_disp_alt'/2,1012,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), get_value(x(1),0), cut(x(2)), proceed, label(1), trust_me_else_fail, allocate(9), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(0),0), put_variable(y(3),1), put_variable(y(4),2), put_variable(y(5),3), put_variable(y(6),4), call('$choice_point_info'/5), put_value(y(6),0), put_value(y(1),1), call('$debug_disp_alt'/2), put_value(y(4),0), put_value(y(5),1), put_variable(y(7),2), put_variable(y(8),3), call('$pred_without_aux'/4), put_value(y(3),0), put_value(y(7),1), put_value(y(8),2), put_value(y(0),3), call('$debug_disp_alt1'/4), cut(y(2)), deallocate, proceed]). predicate(system:'$debug_disp_alt1'/4,1022,static,private,monofile,built_in,[ try_me_else(1), get_atom(system,0), put_value(x(1),0), execute('$debug_is_debug_predicate'/1), label(1), retry_me_else(2), allocate(4), put_variable(y(0),2), put_variable(x(0),4), put_variable(x(1),5), call_c('Pl_Scan_Choice_Point_Info_4',[boolean],[x(3),x(2),x(4),x(5)]), put_variable(y(1),2), put_variable(y(2),3), call('$pred_without_aux'/4), put_value(y(1),0), put_value(y(2),1), put_value(y(0),2), put_variable(y(3),3), call('$debug_qualify_pi_pretty'/4), put_unsafe_value(y(3),0), deallocate, execute('$debug_disp_alt2'/1), label(2), retry_me_else(9), switch_on_term(5,3,fail,fail,fail), label(3), switch_on_atom([(system,4)]), label(4), try(6), trust(8), label(5), try_me_else(7), label(6), allocate(1), get_atom(system,0), get_atom('$catch_internal1',1), get_integer(6,2), put_value(x(3),0), put_integer(1,1), put_variable(y(0),2), call('$choice_point_arg'/3), put_unsafe_value(y(0),1), put_variable(x(0),2), put_void(3), call_c('Pl_Blt_Functor',[fast_call,boolean],[x(1),x(2),x(3)]), deallocate, execute('$debug_is_debug_predicate'/1), label(7), trust_me_else_fail, label(8), get_atom(system,0), get_atom('$trail_handler',1), get_integer(1,2), proceed, label(9), retry_me_else(10), allocate(3), get_variable(y(0),0), get_variable(y(1),1), get_variable(y(2),2), put_value(y(1),0), put_integer(0,1), put_integer(1,2), put_void(3), put_atom($,4), call(sub_atom/5), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_atom(native_code,3), call('$predicate_property1'/4), put_value(y(1),0), put_value(y(2),1), deallocate, execute('$$debug_disp_alt1/4_$aux1'/2), label(10), trust_me_else_fail, allocate(1), get_variable(x(3),2), get_variable(x(2),0), put_value(x(1),0), put_value(x(3),1), put_variable(y(0),3), call('$debug_qualify_pi_pretty'/4), put_unsafe_value(y(0),0), deallocate, execute('$debug_disp_alt2'/1)]). predicate(system:'$$debug_disp_alt1/4_$aux1'/2,1038,static,private,monofile,local,[ pragma_arity(3), get_current_choice(x(2)), try_me_else(1), allocate(3), get_variable(y(0),2), put_variable(y(1),1), put_variable(y(2),2), call('$$debug_disp_alt1/4_$aux2'/3), cut(y(0)), put_structure((/)/2,0), unify_local_value(y(1)), unify_local_value(y(2)), deallocate, execute('$debug_disp_alt2'/1), label(1), trust_me_else_fail, get_variable(x(2),0), put_structure('system predicate'/1,0), unify_structure((/)/2), unify_local_value(x(2)), unify_local_value(x(1)), execute('$debug_disp_alt2'/1)]). predicate(system:'$$debug_disp_alt1/4_$aux2'/3,1038,static,private,monofile,local,[ try_me_else(1), allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_integer(1,1), put_void(2), put_integer(4,3), put_value(y(0),4), call(sub_atom/5), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$debug_check_bip'/2), label(1), trust_me_else_fail, allocate(2), get_variable(y(0),1), get_variable(y(1),2), put_integer(1,1), put_void(2), put_integer(1,3), put_value(y(0),4), call(sub_atom/5), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$debug_check_bip'/2)]). predicate(system:'$debug_disp_alt2'/1,1057,static,private,monofile,built_in,[ put_list(2), unify_local_value(x(0)), unify_nil, put_atom(debugger_output,0), put_atom('~N 1 choice-point for ~w~n',1), execute(format/3)]). predicate(system:'$debug_is_debug_predicate'/1,1063,static,private,monofile,built_in,[ put_integer(0,1), put_integer(7,2), put_void(3), put_atom('$debug_',4), execute(sub_atom/5)]). predicate(system:'$debug_check_bip'/2,1069,static,private,monofile,built_in,[ get_variable(x(2),1), put_value(x(0),1), put_atom(user,0), put_atom(built_in,3), execute('$predicate_property1'/4)]). predicate(system:'$debug_disp_help'/0,1080,static,private,monofile,built_in,[ allocate(0), put_atom(debugger_output,0), put_atom('Debugging commands:~n~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom('RET/c creep l leap ~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' s skip G goto~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' r retry f fail~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' w write d display~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' p print e exception~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' g ancestors A alternatives~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' u unify . father file~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' n nodebug = debugging~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' + spy this * spy conditionally~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' - nospy this L listing~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' a abort b break~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' @ command < set printdepth~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), put_atom(' h/? help W WAM debugger~n',1), put_nil(2), call(format/3), put_atom(debugger_output,0), deallocate, execute(nl/1)]). predicate(system:'$choice_point_info'/5,1101,static,private,monofile,built_in,[ call_c('Pl_Choice_Point_Info_5',[],[x(0),x(1),x(2),x(3),x(4)]), proceed]). predicate(system:'$choice_point_arg'/3,1105,static,private,monofile,built_in,[ call_c('Pl_Choice_Point_Arg_3',[],[x(0),x(1),x(2)]), proceed]). directive(249,system,[ put_atom(user,0), put_structure(spypoint_condition/3,1), unify_atom(:), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(286,system,[ put_atom(user,0), put_structure(spy/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). directive(303,system,[ put_atom(user,0), put_structure(nospy/1,1), unify_atom(:), execute('$declare_meta_predicate'/2)]). ��������������������������������������������������gprolog-1.4.5/src/BipsPl/foreign_supp.c�������������������������������������������������������������0000644�0001750�0001750�00000112747�13021324543�016157� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : foreign_supp.c * * Descr.: foreign interface support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #define OBJ_INIT Foreign_Initializer #define FOREIGN_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define QUERY_STACK_SIZE 128 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ PlLong pl_foreign_long[NB_OF_X_REGS]; double pl_foreign_double[NB_OF_X_REGS]; PlLong *pl_base_fl = pl_foreign_long; /* overwrite var of engine.c */ double *pl_base_fd = pl_foreign_double; /* overwrite var of engine.c */ static PlFIOArg fio_arg_array[NB_OF_X_REGS]; static WamWord *query_stack[QUERY_STACK_SIZE]; static WamWord **query_stack_top = query_stack; static WamWord *goal_H; WamWord *pl_query_top_b; /* overwrite var of throw_c.c */ WamWord pl_query_exception; /* overwrite var of throw_c.c */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static CodePtr Prepare_Call(int module, int func, int arity, WamWord *arg_adr); #define CALL_INTERNAL X1_2463616C6C5F696E7465726E616C #define THROW_INTERNAL X1_247468726F775F696E7465726E616C #define PL_QUERY_RECOVER_ALT X1_24706C5F71756572795F7265636F7665725F616C74 Prolog_Prototype(CALL_INTERNAL, 3); Prolog_Prototype(THROW_INTERNAL, 3); Prolog_Prototype(PL_QUERY_RECOVER_ALT, 0); /*-------------------------------------------------------------------------* * FOREIGN_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Foreign_Initializer(void) { goal_H = H; H = H + MAX_ARITY + 1; Pl_Set_Heap_Actual_Start(H); /* reserve space for meta-call goal */ } /*-------------------------------------------------------------------------* * PL_FOREIGN_CREATE_CHOICE * * * *-------------------------------------------------------------------------*/ void Pl_Foreign_Create_Choice(CodePtr codep_alt, int arity, int choice_size) { A(arity) = -1; /* bkt_counter */ Pl_Create_Choice_Point(codep_alt, arity + 1 + choice_size); } /*-------------------------------------------------------------------------* * PL_FOREIGN_UPDATE_CHOICE * * * *-------------------------------------------------------------------------*/ void Pl_Foreign_Update_Choice(CodePtr codep_alt, int arity, int choice_size) { pl_foreign_bkt_counter = AB(B, arity) + 1; AB(B, arity) = pl_foreign_bkt_counter; pl_foreign_bkt_buffer = (char *) (&(AB(B, arity + choice_size))); if (pl_foreign_bkt_counter > 0) { Pl_Update_Choice_Point(codep_alt, arity); } } /*-------------------------------------------------------------------------* * PL_FOREIGN_JUMP_RET * * * *-------------------------------------------------------------------------*/ CodePtr Pl_Foreign_Jump_Ret(CodePtr codep) { return codep; } /*-------------------------------------------------------------------------* * PL_FOREIGN_RD_IO_ARG * * * *-------------------------------------------------------------------------*/ PlFIOArg * Pl_Foreign_Rd_IO_Arg(int arg_long, WamWord start_word, PlLong (*rd_fct) (), int fio_arg_index) { WamWord word, tag_mask; PlFIOArg *fa = fio_arg_array + fio_arg_index; DEREF(start_word, word, tag_mask); fa->is_var = fa->unify = (tag_mask == TAG_REF_MASK); if (rd_fct == NULL) fa->value.l = (PlLong) word; else if (!fa->is_var) { if (arg_long) { fa->value.l = (*rd_fct) (word); if (arg_long == 2) /* strdup needed */ fa->value.s = Strdup(fa->value.s); } else fa->value.d = (*(double (*)()) rd_fct) (word); } return fa; } /*-------------------------------------------------------------------------* * PL_FOREIGN_UN_IO_ARG * * * *-------------------------------------------------------------------------*/ Bool Pl_Foreign_Un_IO_Arg(int arg_long, Bool (*un_fct) (), PlFIOArg *fa, WamWord start_word) { if (!fa->unify) return TRUE; if (arg_long) return (*un_fct) (fa->value.l, start_word); return (*un_fct) (fa->value.d, start_word); } /*-------------------------------------------------------------------------* * PL_EMIT_SYNTAX_ERROR * * * *-------------------------------------------------------------------------*/ void Pl_Emit_Syntax_Error(char *file_name, int err_line, int err_col, char *err_msg) { Pl_Set_Last_Syntax_Error(file_name, err_line, err_col, err_msg); Pl_Syntax_Error(Flag_Value(syntax_error)); } /*-------------------------------------------------------------------------* * PREPARE_CALL * * * *-------------------------------------------------------------------------*/ static CodePtr Prepare_Call(int module, int func, int arity, WamWord *arg_adr) { PredInf *pred; WamWord *w; int i; int bip_func, bip_arity; pred = Pl_Lookup_Pred_Visible(module, func, arity); if (pred == NULL || !(pred->prop & MASK_PRED_NATIVE_CODE) || (pred->prop & MASK_PRED_CONTROL_CONSTRUCT)) { if (arity == 0) A(0) = Tag_ATM(func); else { w = goal_H; A(0) = Tag_STC(w); *w++ = Functor_Arity(func, arity); for (i = 0; i < arity; i++) *w++ = *arg_adr++; } bip_func = Pl_Get_Current_Bip(&bip_arity); A(1) = Tag_ATM(module); A(2) = Tag_INT(Call_Info(bip_func, bip_arity, 0)); return (CodePtr) Prolog_Predicate(CALL_INTERNAL, 3); } for (i = 0; i < arity; i++) A(i) = *arg_adr++; return (CodePtr) (pred->codep); } /*-------------------------------------------------------------------------* * PL_EXEC_CONTINUATION_MODULE * * * *-------------------------------------------------------------------------*/ void Pl_Exec_Continuation_Module(int module, int func, int arity, WamWord *arg_adr) { Pl_Execute_A_Continuation(Prepare_Call(module, func, arity, arg_adr)); } /*-------------------------------------------------------------------------* * PL_EXEC_CONTINUATION * * * *-------------------------------------------------------------------------*/ void Pl_Exec_Continuation(int func, int arity, WamWord *arg_adr) { Pl_Exec_Continuation_Module(pl_atom_user, func, arity, arg_adr); } /*-------------------------------------------------------------------------* * PL_THROW * * * *-------------------------------------------------------------------------*/ void Pl_Throw(WamWord ball_word) { int bip_func, bip_arity; bip_func = Pl_Get_Current_Bip(&bip_arity); A(0) = ball_word; A(1) = pl_atom_user; /* TODO pass module of the caller (for error), see throw.pl */ A(2) = Tag_INT(Call_Info(bip_func, bip_arity, 0)); Pl_Execute_A_Continuation(Prolog_Predicate(THROW_INTERNAL, 3)); } /*-------------------------------------------------------------------------* * PL_QUERY_BEGIN * * * *-------------------------------------------------------------------------*/ void Pl_Query_Begin(Bool recoverable) { if (query_stack_top - query_stack >= QUERY_STACK_SIZE) Pl_Fatal_Error("too many nested Pl_Query_Start() (max: %d)", QUERY_STACK_SIZE); if (recoverable) Pl_Create_Choice_Point(Prolog_Predicate(PL_QUERY_RECOVER_ALT, 0), 0); } /*-------------------------------------------------------------------------* * PL_QUERY_CALL_MODULE * * * *-------------------------------------------------------------------------*/ int Pl_Query_Call_Module(int module, int func, int arity, WamWord *arg_adr) { *query_stack_top++ = pl_query_top_b = B; pl_query_exception = pl_atom_void; return Pl_Call_Prolog(Prepare_Call(module, func, arity, arg_adr)); } /*-------------------------------------------------------------------------* * PL_QUERY_CALL * * * *-------------------------------------------------------------------------*/ int Pl_Query_Call(int func, int arity, WamWord *arg_adr) { return Pl_Query_Call_Module(pl_atom_user, func, arity, arg_adr); } /*-------------------------------------------------------------------------* * PL_QUERY_START_MODULE * * * *-------------------------------------------------------------------------*/ int Pl_Query_Start_Module(int module, int func, int arity, WamWord *arg_adr, Bool recoverable) { Pl_Query_Begin(recoverable); return Pl_Query_Call_Module(module, func, arity, arg_adr); } /*-------------------------------------------------------------------------* * PL_QUERY_START * * * *-------------------------------------------------------------------------*/ int Pl_Query_Start(int func, int arity, WamWord *arg_adr, Bool recoverable) { return Pl_Query_Start_Module(pl_atom_user, func, arity, arg_adr, recoverable); } /*-------------------------------------------------------------------------* * PL_QUERY_RECOVER_ALT_0 * * * * NB: This choice-point is invoked when PL_KEEP_FOR_PROLOG is used * *-------------------------------------------------------------------------*/ void Pl_Query_Recover_Alt_0(void) { Pl_Delete_Choice_Point(0); /* remove recover choice-point */ } /*-------------------------------------------------------------------------* * PL_QUERY_NEXT_SOLUTION * * * *-------------------------------------------------------------------------*/ int Pl_Query_Next_Solution(void) { if (query_stack_top == query_stack) Pl_Fatal_Error("Pl_Query_Next_Solution() but no query remaining"); pl_query_exception = pl_atom_void; return Pl_Call_Prolog_Next_Sol(pl_query_top_b); } /*-------------------------------------------------------------------------* * PL_QUERY_END * * * *-------------------------------------------------------------------------*/ void Pl_Query_End(int op) { WamWord *query_b, *prev_b, *b; Bool recoverable; if (query_stack_top == query_stack) Pl_Fatal_Error("Pl_Query_End() but no query remaining"); query_b = *--query_stack_top; pl_query_top_b = query_stack_top[-1]; recoverable = (ALTB(query_b) == Prolog_Predicate(PL_QUERY_RECOVER_ALT, 0)); prev_b = BB(query_b); switch (op) { case PL_RECOVER: Assign_B(query_b); if (!recoverable) Pl_Fatal_Error("Pl_Query_End(PL_RECOVER) but unrecoverable query"); Pl_Delete_Choice_Point(0); /* remove recover chc-point */ break; case PL_CUT: Assign_B((recoverable) ? prev_b : query_b); break; default: /* case PL_KEEP_FOR_PROLOG */ if (recoverable) { if (B == query_b) Assign_B(prev_b); else for (b = B; b > query_b; b = BB(b)) /* unlink recover chc-point */ if (BB(b) == query_b) BB(b) = prev_b; } Pl_Keep_Rest_For_Prolog(query_b); } } /*-------------------------------------------------------------------------* * PL_GET_EXCEPTION * * * *-------------------------------------------------------------------------*/ WamWord Pl_Get_Exception(void) { return pl_query_exception; } /* * The following functions are defined here to have a minimal gprolog.h */ /*-------------------------------------------------------------------------* * PL_NO_MORE_CHOICE * * * *-------------------------------------------------------------------------*/ void Pl_No_More_Choice(void) { Delete_Last_Choice_Point(); } /*-------------------------------------------------------------------------* * PL_TYPE_OF_TERM * * * *-------------------------------------------------------------------------*/ int Pl_Type_Of_Term(WamWord start_word) { WamWord word, tag_mask; DEREF(start_word, word, tag_mask); return Tag_From_Tag_Mask(tag_mask); } /*-------------------------------------------------------------------------* * PL_ATOM_NAME * * * *-------------------------------------------------------------------------*/ char * Pl_Atom_Name(int atom) { return pl_atom_tbl[atom].name; } /*-------------------------------------------------------------------------* * PL_ATOM_LENGTH * * * *-------------------------------------------------------------------------*/ int Pl_Atom_Length(int atom) { return pl_atom_tbl[atom].prop.length; } /*-------------------------------------------------------------------------* * PL_ATOM_NEEDS_QUOTE * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Needs_Quote(int atom) { return pl_atom_tbl[atom].prop.needs_quote; } /*-------------------------------------------------------------------------* * PL_ATOM_NEEDS_SCAN * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Needs_Scan(int atom) { return pl_atom_tbl[atom].prop.needs_scan; } /*-------------------------------------------------------------------------* * PL_IS_VALID_ATOM * * * *-------------------------------------------------------------------------*/ Bool Pl_Is_Valid_Atom(int atom) { return Is_Valid_Atom(atom); } /*-------------------------------------------------------------------------* * PL_ATOM_CHAR * * * *-------------------------------------------------------------------------*/ int Pl_Atom_Char(char c) { return ATOM_CHAR(c); } /*-------------------------------------------------------------------------* * PL_ATOM_NIL * * * *-------------------------------------------------------------------------*/ int Pl_Atom_Nil(void) { return ATOM_NIL; } /*-------------------------------------------------------------------------* * PL_ATOM_USER * * * *-------------------------------------------------------------------------*/ int Pl_Atom_User(void) { return pl_atom_user; } /*-------------------------------------------------------------------------* * PL_ATOM_SYSTEM * * * *-------------------------------------------------------------------------*/ int Pl_Atom_System(void) { return pl_atom_user; } /*-------------------------------------------------------------------------* * PL_ATOM_FALSE * * * *-------------------------------------------------------------------------*/ int Pl_Atom_False(void) { return pl_atom_false; } /*-------------------------------------------------------------------------* * PL_ATOM_TRUE * * * *-------------------------------------------------------------------------*/ int Pl_Atom_True(void) { return pl_atom_true; } /*-------------------------------------------------------------------------* * PL_ATOM_END_OF_FILE * * * *-------------------------------------------------------------------------*/ int Pl_Atom_End_Of_File(void) { return pl_atom_end_of_file; } /*-------------------------------------------------------------------------* * PL_UNIF * * * * do not use directly Pl_Unify because of FC (fast call) * *-------------------------------------------------------------------------*/ PlBool Pl_Unif(PlTerm term1, PlTerm term2) { return Pl_Unify(term1, term2); } /*-------------------------------------------------------------------------* * PL_UNIF_WITH_OCCURS_CHECK * * * * do not use directly Pl_Unify_Occurs_Check because of FC (fast call) * *-------------------------------------------------------------------------*/ PlBool Pl_Unif_With_Occurs_Check(PlTerm term1, PlTerm term2) { return Pl_Unify_Occurs_Check(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_VAR * * * * do not use directly Pl_Blt_Var because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Var(WamWord term) { return Pl_Blt_Var(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_NON_VAR * * * * do not use directly Pl_Blt_Non_Var because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Non_Var(WamWord term) { return Pl_Blt_Non_Var(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_ATOM * * * * do not use directly Pl_Blt_Atom because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Atom(WamWord term) { return Pl_Blt_Atom(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_INTEGER * * * * do not use directly Pl_Blt_Integer because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Integer(WamWord term) { return Pl_Blt_Integer(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_FLOAT * * * * do not use directly Pl_Blt_Float because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Float(WamWord term) { return Pl_Blt_Float(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_NUMBER * * * * do not use directly Pl_Blt_Number because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Number(WamWord term) { return Pl_Blt_Number(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_ATOMIC * * * * do not use directly Pl_Blt_Atomic because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Atomic(WamWord term) { return Pl_Blt_Atomic(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_COMPOUND * * * * do not use directly Pl_Blt_Compound because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Compound(WamWord term) { return Pl_Blt_Compound(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_Callable * * * * do not use directly Pl_Blt_Callable because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Callable(WamWord term) { return Pl_Blt_Callable(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_FD_VAR * * * * do not use directly Pl_Blt_Fd_Var because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Fd_Var(WamWord term) { return Pl_Blt_Fd_Var(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_NON_FD_VAR * * * * do not use directly Pl_Blt_Non_Fd_Var because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Non_Fd_Var(WamWord term) { return Pl_Blt_Non_Fd_Var(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_GENERIC_VAR * * * * do not use directly Pl_Blt_Generic_Var because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Generic_Var(WamWord term) { return Pl_Blt_Generic_Var(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_NON_GENERIC_VAR * * * * do not use directly Pl_Blt_Non_Generic_Var because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Non_Generic_Var(WamWord term) { return Pl_Blt_Non_Generic_Var(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_LIST * * * * do not use directly Pl_Blt_List because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_List(WamWord term) { return Pl_Blt_List(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_PARTIAL_LIST * * * * do not use directly Pl_Blt_Partial_List because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Partial_List(WamWord term) { return Pl_Blt_Partial_List(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_LIST_OR_PARTIAL_LIST * * * * do not use directly Pl_Blt_List_Or_Partial_List because of FC(fast call)* *-------------------------------------------------------------------------*/ Bool Pl_Builtin_List_Or_Partial_List(WamWord term) { return Pl_Blt_List_Or_Partial_List(term); } /*-------------------------------------------------------------------------* * PL_BUILTIN_TERM_EQ * * * * do not use directly Pl_Blt_Term_Eq because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Term_Eq(WamWord term1, WamWord term2) { return Pl_Blt_Term_Eq(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_TERM_NEQ * * * * do not use directly Pl_Blt_Term_Neq because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Term_Neq(WamWord term1, WamWord term2) { return Pl_Blt_Term_Neq(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_TERM_LT * * * * do not use directly Pl_Blt_Term_Lt because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Term_Lt(WamWord term1, WamWord term2) { return Pl_Blt_Term_Lt(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_TERM_LTE * * * * do not use directly Pl_Blt_Term_Lte because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Term_Lte(WamWord term1, WamWord term2) { return Pl_Blt_Term_Lte(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_TERM_GT * * * * do not use directly Pl_Blt_Term_Gt because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Term_Gt(WamWord term1, WamWord term2) { return Pl_Blt_Term_Gt(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_TERM_GTE * * * * do not use directly Pl_Blt_Term_Gte because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Term_Gte(WamWord term1, WamWord term2) { return Pl_Blt_Term_Gte(term1, term2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_COMPARE * * * * do not use directly Pl_Blt_Compare because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Compare(WamWord cmp_word, WamWord x, WamWord y) { return Pl_Blt_Compare(cmp_word, x, y); } /*-------------------------------------------------------------------------* * PL_BUILTIN_ARG * * * * do not use directly Pl_BLT_Arg because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Arg(WamWord arg_no_word, WamWord term_word, WamWord sub_term_word) { return Pl_Blt_Arg(arg_no_word, term_word, sub_term_word); } /*-------------------------------------------------------------------------* * PL_BUILTIN_FUNCTOR * * * * do not use directly Pl_BLT_Functor because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Functor(WamWord term_word, WamWord functor_word, WamWord arity_word) { return Pl_Blt_Functor(term_word, functor_word, arity_word); } /*-------------------------------------------------------------------------* * PL_BUILTIN_UNIV * * * * do not use directly Pl_BLT_Univ because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Univ(WamWord term_word, WamWord list_word) { return Pl_Blt_Univ(term_word, list_word); } /*-------------------------------------------------------------------------* * PL_BUILTIN_EQ * * * * do not use directly Pl_Blt_Eq because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Eq(WamWord expr1, WamWord expr2) { return Pl_Blt_Eq(expr1, expr2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_NEQ * * * * do not use directly Pl_Blt_Neq because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Neq(WamWord expr1, WamWord expr2) { return Pl_Blt_Neq(expr1, expr2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_LT * * * * do not use directly Pl_Blt_Lt because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Lt(WamWord expr1, WamWord expr2) { return Pl_Blt_Lt(expr1, expr2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_LTE * * * * do not use directly Pl_Blt_Lte because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Lte(WamWord expr1, WamWord expr2) { return Pl_Blt_Lte(expr1, expr2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_GT * * * * do not use directly Pl_Blt_Gt because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Gt(WamWord expr1, WamWord expr2) { return Pl_Blt_Gt(expr1, expr2); } /*-------------------------------------------------------------------------* * PL_BUILTIN_GTE * * * * do not use directly Pl_Blt_Gte because of FC (fast call) * *-------------------------------------------------------------------------*/ Bool Pl_Builtin_Gte(WamWord expr1, WamWord expr2) { return Pl_Blt_Gte(expr1, expr2); } /*-------------------------------------------------------------------------* * PL_MATH_EVALUATE * * * * do not use directly Pl_Math_Load_Value because of FC (fast call) * *-------------------------------------------------------------------------*/ void Pl_Math_Evaluate(WamWord expr, WamWord *result) { Pl_Math_Load_Value(expr, result); } �������������������������gprolog-1.4.5/src/BipsPl/dynam_supp.c���������������������������������������������������������������0000644�0001750�0001750�00000112627�13021324543�015633� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : dynam_supp.c * * Descr.: dynamic predicate support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include "engine_pl.h" #include "bips_pl.h" #if 0 #define DEBUG #endif #if 0 #define DEBUG1 #endif /*---------------------------------* * Constants * *---------------------------------*/ #define DYN_STAMP_NONE ((DynStamp) -1) #define ALL_MUST_BE_ERASED (DynCInf *) 2 /* bit 0 used for mark */ #define MAX_KBYTES_BEFORE_CLEAN 512 #define MAX_SIZE_BEFORE_CLEAN (MAX_KBYTES_BEFORE_CLEAN * 1024 / sizeof(WamWord)) #define START_DYNAMIC_SWT_SIZE 32 #define NO_INDEX 0 #define VAR_INDEX 1 #define ATM_INDEX 2 #define INT_INDEX 3 #define LST_INDEX 4 #define STC_INDEX 5 /*---------------------------------* * Type Definitions * *---------------------------------*/ /* NB: the owner can be different from the predicate wich is scanned. * for instance for clause(p(X),Y) the owner is system:clause/2. * This information is used by the dbg. * * The information on associated pred (thus module:f/n) can be retrieved from dyn->pred. */ typedef struct /* Dynamic clause scanning info */ { /* --------- input data --------- */ DynPInf *dyn; /* associated dyn info (back link)*/ int owner_module; /* module of the owner (see above)*/ int owner_func; /* func of the owner (see above)*/ int owner_arity; /* arity of the owner (see above)*/ ScanFct alt_fct; /* fct to call for each clause */ int alt_size_info; /* user alt info size */ int stop_cl_no; /* clause # to reach to stop scan */ DynStamp erase_stamp; /* max stamp to perform a retract */ Bool xxx_is_seq_chain; /* scan all clauses ? */ DynCInf *xxx_ind_chain; /* current assoc idx (->clause) */ DynCInf *var_ind_chain; /* current var idx (->clause) */ DynCInf *clause; /* current clause */ } DynScan; /*---------------------------------* * Global Variables * *---------------------------------*/ static DynStamp erase_stamp = 1; static DynPInf *first_dyn_with_erase = NULL; static int size_of_erased = 0; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static DynPInf *Alloc_Init_Dyn_Info(PredInf *pred, int arity); static int Index_From_First_Arg(WamWord first_arg_word, PlLong *key); static void Add_To_2Chain(D2ChHdr *hdr, DynCInf *clause, Bool in_seq_chain, Bool asserta); static void Remove_From_2Chain(D2ChHdr *hdr, DynCInf *clause, Bool in_seq_chain); static void Erase_All(DynPInf *dyn); static void Erase_All_Clauses_Of_File(DynPInf *dyn, int pl_file); static void Clean_Erased_Clauses(void); static void Unlink_Clause(DynCInf *clause); static void Free_Clause(DynCInf *clause); static DynScan *Get_Scan_Choice_Point(WamWord *b); static DynCInf *Scan_Dynamic_Pred_Next(DynScan *scan); #if defined(DEBUG) || defined(DEBUG1) static void Check_Dynamic_Clauses(DynPInf *dyn); static void Check_Hash(char *t, int index_no); static void Check_Chain(D2ChHdr *p, int index_no); #endif #define SCAN_DYN_TEST_ALT X1_247363616E5F64796E5F746573745F616C74 #define SCAN_DYN_FAIL_ALT X1_247363616E5F64796E5F6661696C5F616C74 #define SCAN_DYN_JUMP_ALT X1_247363616E5F64796E5F6A756D705F616C74 Prolog_Prototype(SCAN_DYN_TEST_ALT, 0); Prolog_Prototype(SCAN_DYN_FAIL_ALT, 0); Prolog_Prototype(SCAN_DYN_JUMP_ALT, 0); /*-------------------------------------------------------------------------* * Dynamic clause management * * * * Dynamic clauses are stored in clause frames allocated by malloc. * * The frame consists of: * * * * - a number (<0 if asserta >=0 if assertz) to order them. * * - a forward sequential chain (chronological chain). * * - a backward sequential chain (chronological chain). * * - a forward indexing chain * * - a backward indexing chain * * - the clause number * * - the erase stamp (only if the clause is reased, DYN_STAMP_NONE else) * * - the pointer to the next erased clause (only if the clause is erased)* * - the pointer to the byte-code (or NULL if the clause is interpreted) * * - the size of the Prolog term * * - the corresponding Prolog term of the form [Head|Body] for Head:-Body* * * * For a dynamic predicate the structure DynPInfo has 6 entry-points for * * clause chaining (2-link chains, with next of last = NULL): * * 1 for the sequential chain, 5 for indexing chains, depending on the * * first argument of the Head: * * * * - seq_chain : a chain to the first clause * * - var_ind_chain: a chain to the first clause with a var as 1st arg * * - atm_htbl : a hash table: key=atm/info=chain to the first clause * * - int_htbl : a hash table: key=int/info=chain to the first clause * * - lst_ind_chain: a chain to the first clause with a list as 1st arg * * - stc_htbl : a hash table: key=f_n/info=chain to the first clause * * * * This clause management uses the logical database update view, ie. the * * different altenatives of a predicate are not influenced by subsequent * * actions. When a predicate must be scanned (cf. Scan_Dynamic_Pred) we * * must ensure that subsequent retracted clause must be selected and all * * subsequent added clause must be ignored. * * For added clause we use the count_z value when the selection starts (cf.* * stop_cl_no). A clause is ignored if its clause number (cl_no) is >= to * * stop_cl_no. * * For retracted clause we use a stamp incremented at each selection. When * * a clause is retracted its erase_stamp is set to the current stamp. Then * * an erased clause ignored for a selection if its stamp is <= to the stamp* * of the selection. * * All erased clause of a predicate are linked (first_erased_cl / * * next_erased_cl). * * All dynamic predicates with at least one erased clause are linked * * (first_dyn_with_erase / next_dyn_with_erase). * * Erased clauses are physically cleaned when MAX_KBYTES_BEFORE_CLEAN are * * reached. Then the local stack is scanned to detect all predicates with * * selections and to mark them. All erased clauses of a predicate which is * * not marked are physically destroyed (free). * * * * pl_file is the file name of its definition (or -1). Used for multifile * * predicates by consult/1 (see Pl_Update_Dynamic_Pred). *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * PL_CREATE_DYNAMIC_PRED * * * *-------------------------------------------------------------------------*/ PredInf * Pl_Create_Dynamic_Pred(int module, int func, int arity) { return Pl_Create_Pred(module, func, arity, pl_atom_user_input, pl_stm_tbl[pl_stm_stdin]->line_count, MASK_PRED_DYNAMIC | MASK_PRED_PUBLIC, NULL); } /*-------------------------------------------------------------------------* * PL_ADD_DYNAMIC_CLAUSE * * * *-------------------------------------------------------------------------*/ DynCInf * Pl_Add_Dynamic_Clause(int module, WamWord head_word, WamWord body_word, Bool asserta, Bool check_perm, int pl_file) { WamWord word; WamWord *first_arg_adr; int func, arity; PredInf *pred; int index_no; PlLong key; DynCInf *clause; DynPInf *dyn; char **p_ind_htbl; D2ChHdr *p_ind_hdr; DSwtInf swt_info; DSwtInf *swt; int size; WamWord lst_h_b; first_arg_adr = Pl_Rd_Callable_Check(head_word, &func, &arity); #ifdef DEBUG DBGPRINTF("\tarity: %d", arity); if (arity > 0) { DBGPRINTF("\tfirst arg: "); Pl_Write(*first_arg_adr); } DBGPRINTF("\n"); #endif pred = Pl_Lookup_Pred(module, func, arity); if (pred == NULL #if 0 /* useless if we use Pl_Lookup_Pred_In_Module instead of Pl_Lookup_Pred */ || /* test now if it hiddes an existing pred (if yes: create) */ (pred->mod->module != module && pred->mod->module != pl_atom_system && module != pl_atom_system) #endif ) pred = Pl_Create_Dynamic_Pred(module, func, arity); else if (check_perm && !(pred->prop & MASK_PRED_DYNAMIC)) { word = Pl_Build_Pred_Indic_Error(pred); Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_static_procedure, word); } if (pl_file == pl_atom_void) pl_file = -1; dyn = (DynPInf *) (pred->dyn); if (dyn == NULL) /* dynamic info not yet allocated ? */ dyn = Alloc_Init_Dyn_Info(pred, arity); index_no = (dyn->arity) ? Index_From_First_Arg(*first_arg_adr, &key) : NO_INDEX; #ifdef DEBUG DBGPRINTF("\n"); DBGPRINTF("asserta: %d Clause: ", asserta); DBGPRINTF("\thead: "); Pl_Write(head_word); DBGPRINTF("\tbody: "); Pl_Write(body_word); DBGPRINTF("\nByte Code at :%p\n", pl_byte_code); #endif lst_h_b = Tag_LST(H); H[0] = head_word; H[1] = body_word; size = Pl_Term_Size(lst_h_b); clause = (DynCInf *) Malloc(sizeof(DynCInf) - 3 * sizeof(WamWord) + size * sizeof(WamWord)); Add_To_2Chain(&dyn->seq_chain, clause, TRUE, asserta); clause->dyn = dyn; clause->cl_no = (asserta) ? dyn->count_a-- : dyn->count_z++; clause->pl_file = pl_file; clause->erase_stamp = DYN_STAMP_NONE; clause->next_erased_cl = NULL; clause->term_size = size; Pl_Copy_Term(&clause->term_word, &lst_h_b); clause->byte_code = pl_byte_code; pl_byte_code = NULL; switch(index_no) { case NO_INDEX: clause->ind_chain.next = NULL; clause->ind_chain.prev = NULL; p_ind_hdr = NULL; p_ind_htbl = NULL; break; case VAR_INDEX: p_ind_hdr = &(dyn->var_ind_chain); p_ind_htbl = NULL; break; case LST_INDEX: p_ind_hdr = &(dyn->lst_ind_chain); p_ind_htbl = NULL; break; case ATM_INDEX: p_ind_htbl = &(dyn->atm_htbl); break; case INT_INDEX: p_ind_htbl = &(dyn->int_htbl); break; case STC_INDEX: p_ind_htbl = &(dyn->stc_htbl); break; } clause->p_ind_htbl = p_ind_htbl; if (p_ind_htbl) { if (*p_ind_htbl == NULL) *p_ind_htbl = Pl_Hash_Alloc_Table(START_DYNAMIC_SWT_SIZE, sizeof(DSwtInf)); swt_info.key = key; swt_info.ind_chain.first = swt_info.ind_chain.last = NULL; Pl_Extend_Table_If_Needed(p_ind_htbl); swt = (DSwtInf *) Pl_Hash_Insert(*p_ind_htbl, (char *) &swt_info, FALSE); p_ind_hdr = &(swt->ind_chain); } clause->p_ind_hdr = p_ind_hdr; if (p_ind_hdr) Add_To_2Chain(p_ind_hdr, clause, FALSE, asserta); #ifdef DEBUG Check_Dynamic_Clauses(dyn); #endif return clause; } /*-------------------------------------------------------------------------* * ALLOC_INIT_DYN_INFO * * * *-------------------------------------------------------------------------*/ static DynPInf * Alloc_Init_Dyn_Info(PredInf *pred, int arity) { DynPInf *dyn; dyn = (DynPInf *) Malloc(sizeof(DynPInf)); dyn->seq_chain.first = dyn->seq_chain.last = NULL; dyn->var_ind_chain.first = dyn->var_ind_chain.last = NULL; dyn->lst_ind_chain.first = dyn->lst_ind_chain.last = NULL; dyn->atm_htbl = dyn->int_htbl = dyn->stc_htbl = NULL; dyn->pred = pred; dyn->arity = arity; dyn->count_a = -1; dyn->count_z = 0; dyn->first_erased_cl = NULL; dyn->next_dyn_with_erase = NULL; pred->dyn = (PlLong *) dyn; return dyn; } /*-------------------------------------------------------------------------* * INDEX_FROM_FIRST_ARG * * * *-------------------------------------------------------------------------*/ static int Index_From_First_Arg(WamWord first_arg_word, PlLong *key) { WamWord word, tag_mask; int index_no; DEREF(first_arg_word, word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { case REF: #ifndef NO_USE_FD_SOLVER case FDV: #endif index_no = VAR_INDEX; break; case INT: index_no = INT_INDEX; *key = UnTag_INT(word); break; case ATM: index_no = ATM_INDEX; *key = (PlLong) UnTag_ATM(word); break; case FLT: index_no = NO_INDEX; break; case LST: index_no = LST_INDEX; break; default: /* tag==STC */ index_no = STC_INDEX; *key = (PlLong) Functor_And_Arity(UnTag_STC(word)); break; } return index_no; } /*-------------------------------------------------------------------------* * ADD_TO_2CHAIN * * * *-------------------------------------------------------------------------*/ static void Add_To_2Chain(D2ChHdr *hdr, DynCInf *clause, Bool in_seq_chain, Bool asserta) { D2ChCell *cell = (in_seq_chain) ? &clause->seq_chain : &clause->ind_chain; if (hdr->first == NULL) /* empty chain ? */ { hdr->first = hdr->last = clause; cell->next = cell->prev = NULL; return; } if (asserta) { cell->next = hdr->first; cell->prev = NULL; hdr->first = clause; if (in_seq_chain) cell->next->seq_chain.prev = clause; else cell->next->ind_chain.prev = clause; } else { if (in_seq_chain) hdr->last->seq_chain.next = clause; else hdr->last->ind_chain.next = clause; cell->next = NULL; cell->prev = hdr->last; hdr->last = clause; } } /*-------------------------------------------------------------------------* * REMOVE_FROM_2CHAIN * * * *-------------------------------------------------------------------------*/ static void Remove_From_2Chain(D2ChHdr *hdr, DynCInf *clause, Bool in_seq_chain) { D2ChCell *cell = (in_seq_chain) ? &clause->seq_chain : &clause->ind_chain; DynCInf *prev = cell->prev; DynCInf *next = cell->next; if (prev == NULL) /* first cell ? */ hdr->first = next; else { if (in_seq_chain) prev->seq_chain.next = next; else prev->ind_chain.next = next; } if (next == NULL) /* last cell ? */ hdr->last = prev; else { if (in_seq_chain) next->seq_chain.prev = prev; else next->ind_chain.prev = prev; } } /*-------------------------------------------------------------------------* * PL_DELETE_DYNAMIC_CLAUSE * * * * This comes down to erase the clause, ie. set it to current erase_stamp * *-------------------------------------------------------------------------*/ void Pl_Delete_Dynamic_Clause(DynCInf *clause) { DynPInf *dyn; Bool first; dyn = clause->dyn; first = (dyn->first_erased_cl == NULL); clause->erase_stamp = erase_stamp; clause->next_erased_cl = dyn->first_erased_cl; dyn->first_erased_cl = clause; if (first) { dyn->next_dyn_with_erase = first_dyn_with_erase; first_dyn_with_erase = dyn; } size_of_erased += clause->term_size; Clean_Erased_Clauses(); #ifdef DEBUG Check_Dynamic_Clauses(dyn); #endif } /*-------------------------------------------------------------------------* * ERASE_ALL_CLAUSES_OF_FILE * * * * This function is called to erase all clauses associated to a given file * * (this is for consult/1 on a multifile pred). * *-------------------------------------------------------------------------*/ static void Erase_All_Clauses_Of_File(DynPInf *dyn, int pl_file) { DynCInf *clause; if (dyn == NULL) return; for (clause = dyn->seq_chain.first; clause; clause = clause->seq_chain.next) { if (clause->erase_stamp == DYN_STAMP_NONE && clause->pl_file == pl_file) Pl_Delete_Dynamic_Clause(clause); } #if 0 Clean_Erased_Clauses(); #endif } /*-------------------------------------------------------------------------* * ERASE_ALL * * * * This function is called to erase all clauses and, when possible, to free* * dyn with all associated info (hash tables,...) * *-------------------------------------------------------------------------*/ static void Erase_All(DynPInf *dyn) { Bool first; DynCInf *clause; if (dyn == NULL) return; first = (dyn->first_erased_cl == NULL); dyn->first_erased_cl = ALL_MUST_BE_ERASED; if (first) { dyn->next_dyn_with_erase = first_dyn_with_erase; first_dyn_with_erase = dyn; } for (clause = dyn->seq_chain.first; clause; clause = clause->seq_chain.next) { if (clause->erase_stamp == DYN_STAMP_NONE) size_of_erased += clause->term_size; } Clean_Erased_Clauses(); } /*-------------------------------------------------------------------------* * CLEAN_ERASED_CLAUSES * * * *-------------------------------------------------------------------------*/ static void Clean_Erased_Clauses(void) { WamWord *b, *base; DynScan *scan; DynPInf *dyn, *dyn1, **prev; DynCInf *clause, *clause1; if (size_of_erased <= MAX_SIZE_BEFORE_CLEAN) return; base = Local_Stack; for (b = B; b > base; b = BB(b)) { scan = Get_Scan_Choice_Point(b); if (scan == NULL) continue; dyn = scan->dyn; if (dyn->first_erased_cl) /* we must keep it - free impossible */ dyn->first_erased_cl = (DynCInf *) ((PlULong) (dyn->first_erased_cl) | 1); /* mark it */ } prev = &first_dyn_with_erase; for (dyn = first_dyn_with_erase; dyn; dyn = dyn1) { dyn1 = dyn->next_dyn_with_erase; if ((PlLong) (dyn->first_erased_cl) & 1) /* marked ? */ { /* cannot free it */ dyn->first_erased_cl = (DynCInf *) ((PlULong) (dyn->first_erased_cl) & (~1)); prev = &(dyn->next_dyn_with_erase); continue; } /* not marked - can be cleaned */ *prev = dyn->next_dyn_with_erase; if (dyn->first_erased_cl == ALL_MUST_BE_ERASED) /* clean all ? */ { for (clause = dyn->seq_chain.first; clause; clause = clause1) { clause1 = clause->seq_chain.next; size_of_erased -= clause->term_size; Free_Clause(clause); } if (dyn->atm_htbl) Pl_Hash_Free_Table(dyn->atm_htbl); if (dyn->int_htbl) Pl_Hash_Free_Table(dyn->int_htbl); if (dyn->stc_htbl) Pl_Hash_Free_Table(dyn->stc_htbl); Free(dyn); continue; } for (clause = dyn->first_erased_cl; clause; clause = clause1) { clause1 = clause->next_erased_cl; size_of_erased -= clause->term_size; Unlink_Clause(clause); Free_Clause(clause); } dyn->first_erased_cl = NULL; dyn->next_dyn_with_erase = NULL; if (dyn->seq_chain.first == NULL) /* no more clauses */ { if (dyn->atm_htbl) Pl_Hash_Free_Table(dyn->atm_htbl); if (dyn->int_htbl) Pl_Hash_Free_Table(dyn->int_htbl); if (dyn->stc_htbl) Pl_Hash_Free_Table(dyn->stc_htbl); dyn->atm_htbl = dyn->int_htbl = dyn->stc_htbl = NULL; dyn->count_a = -1; dyn->count_z = 0; } #ifdef DEBUG1 Check_Dynamic_Clauses(dyn); #endif } } /*-------------------------------------------------------------------------* * UNLINK_CLAUSE * * * *-------------------------------------------------------------------------*/ static void Unlink_Clause(DynCInf *clause) { DynPInf *dyn = clause->dyn; PlLong *p_key; DSwtInf swt_info; Remove_From_2Chain(&dyn->seq_chain, clause, TRUE); if (clause->p_ind_hdr) Remove_From_2Chain(clause->p_ind_hdr, clause, FALSE); if (clause->p_ind_htbl && clause->ind_chain.prev == NULL && clause->ind_chain.next == NULL) { p_key = (PlLong *) ((char *) clause->p_ind_hdr - ((char *) &(swt_info.ind_chain) - (char *) &(swt_info.key))); #ifdef DEBUG1 DBGPRINTF("Removing last ind key in a hash table (%" PL_FMT_d ")\n", *p_key); #endif Pl_Hash_Delete(*clause->p_ind_htbl, *p_key); } } /*-------------------------------------------------------------------------* * FREE_CLAUSE * * * *-------------------------------------------------------------------------*/ static void Free_Clause(DynCInf *clause) { if (clause->byte_code) Free(clause->byte_code); Free(clause); } /*-------------------------------------------------------------------------* * PL_UPDATE_DYNAMIC_PRED * * * * what_to_do: bit 0: with check dynamic ? * * bit 1: also predicate definition ? * * examples : 0 for consult/1 * * 1 for retractall/1 * * 2 for '$remove_predicate'/2 * * 3 for abolish/1 * * * * pl_file_for_multi is for consulting a multifle pred defined in this file* * (else pl_file_for_multi = -1). In this case, and if a previous * * predicate exists, only the clauses defined in this file are removed. * * * * returns a pointer to associated pred or NULL if it does not exist. * *-------------------------------------------------------------------------*/ PredInf * Pl_Update_Dynamic_Pred(int module, int func, int arity, int what_to_do, int pl_file_for_multi) { WamWord word; PredInf *pred; pred = Pl_Lookup_Pred(module, func, arity); if (pred == NULL) return NULL; if ((what_to_do & 1) && !(pred->prop & MASK_PRED_DYNAMIC)) { word = Pl_Build_Pred_Indic_Error(pred); Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_static_procedure, word); } if (pl_file_for_multi >= 0 && (pred->prop & MASK_PRED_MULTIFILE)) { Erase_All_Clauses_Of_File((DynPInf *) (pred->dyn), pl_file_for_multi); } else { Erase_All((DynPInf *) (pred->dyn)); pred->dyn = NULL; } if ((what_to_do & 2)) { Pl_Delete_Pred(module, func, arity); return NULL; } return pred; } /*-------------------------------------------------------------------------* * GET_SCAN_CHOICE_POINT * * * *-------------------------------------------------------------------------*/ static DynScan * Get_Scan_Choice_Point(WamWord *b) { DynScan *scan; int i; if (ALTB(b) != (CodePtr) Prolog_Predicate(SCAN_DYN_TEST_ALT, 0) && ALTB(b) != (CodePtr) Prolog_Predicate(SCAN_DYN_JUMP_ALT, 0)) return NULL; i = sizeof(DynScan) / sizeof(WamWord) - 1; scan = (DynScan *) &AB(b, i); return scan; } /*-------------------------------------------------------------------------* * PL_SCAN_DYNAMIC_PRED * * * *-------------------------------------------------------------------------*/ DynCInf * Pl_Scan_Dynamic_Pred(PredInf *pred, WamWord first_arg_word, int owner_module, int owner_func, int owner_arity, ScanFct alt_fct, int alt_fct_type, int alt_info_size, WamWord *alt_info) { DynPInf *dyn = (DynPInf *) pred->dyn; /* not NULL */ int index_no; PlLong key; char **p_ind_htbl; DSwtInf *swt; DynScan scan; DynCInf *clause; WamWord *adr; int i; CodePtr scan_alt; if (owner_func < 0) { owner_module = pl_atom_system; /* a built-in */ owner_func = Pl_Get_Current_Bip(&owner_arity); } index_no = (dyn->arity) ? Index_From_First_Arg(first_arg_word, &key) : NO_INDEX; scan.dyn = dyn; scan.owner_module = owner_module; scan.owner_func = owner_func; scan.owner_arity = owner_arity; scan.alt_fct = alt_fct; scan.alt_size_info = alt_info_size; scan.stop_cl_no = dyn->count_z; scan.erase_stamp = erase_stamp++; switch (index_no) { case NO_INDEX: case VAR_INDEX: scan.xxx_is_seq_chain = TRUE; scan.xxx_ind_chain = dyn->seq_chain.first; p_ind_htbl = NULL; break; case LST_INDEX: scan.xxx_is_seq_chain = FALSE; scan.xxx_ind_chain = dyn->lst_ind_chain.first; p_ind_htbl = NULL; break; case ATM_INDEX: p_ind_htbl = &(dyn->atm_htbl); break; case INT_INDEX: p_ind_htbl = &(dyn->int_htbl); break; case STC_INDEX: p_ind_htbl = &(dyn->stc_htbl); break; } if (p_ind_htbl) { scan.xxx_is_seq_chain = FALSE; if (*p_ind_htbl && (swt = (DSwtInf *) Pl_Hash_Find(*p_ind_htbl, key)) != NULL) scan.xxx_ind_chain = swt->ind_chain.first; else scan.xxx_ind_chain = NULL; } if (scan.xxx_is_seq_chain) scan.var_ind_chain = NULL; else scan.var_ind_chain = dyn->var_ind_chain.first; clause = Scan_Dynamic_Pred_Next(&scan); if (clause == NULL) return NULL; if (Scan_Dynamic_Pred_Next(&scan) != NULL) /* non deterministic case */ { i = (sizeof(DynScan) + sizeof(WamWord) - 1) / sizeof(WamWord) + alt_info_size; if (alt_fct_type == DYN_ALT_FCT_FOR_TEST) scan_alt = (CodePtr) Prolog_Predicate(SCAN_DYN_TEST_ALT, 0); else if (alt_fct_type == DYN_ALT_FCT_FOR_FAIL) scan_alt = (CodePtr) Prolog_Predicate(SCAN_DYN_FAIL_ALT, 0); else scan_alt = (CodePtr) Prolog_Predicate(SCAN_DYN_JUMP_ALT, 0); Pl_Create_Choice_Point(scan_alt, i); adr = &AB(B, i) + 1; i = alt_info_size; while (i--) *adr++ = *alt_info++; *(DynScan *) adr = scan; } return clause; } /*-------------------------------------------------------------------------* * SCAN_DYNAMIC_PRED_NEXT * * * *-------------------------------------------------------------------------*/ static DynCInf * Scan_Dynamic_Pred_Next(DynScan *scan) { DynCInf *xxx_ind_chain, *var_ind_chain; DynCInf *xxx_clause, *var_clause; PlLong xxx_nb, var_nb; DynCInf *clause; #ifdef DEBUG DBGPRINTF("Looking for next clause stamp:%" PL_FMT_d, (PlLong) (scan->erase_stamp)); Check_Dynamic_Clauses(scan->dyn); #endif scan->clause = NULL; start: xxx_ind_chain = scan->xxx_ind_chain; if (xxx_ind_chain) { xxx_clause = xxx_ind_chain; xxx_nb = xxx_clause->cl_no; } else xxx_nb = INT_GREATEST_VALUE; var_ind_chain = scan->var_ind_chain; if (var_ind_chain) { var_clause = var_ind_chain; var_nb = var_clause->cl_no; } else var_nb = INT_GREATEST_VALUE; if (xxx_nb <= var_nb) { if (xxx_nb == INT_GREATEST_VALUE) return NULL; clause = xxx_clause; if (scan->xxx_is_seq_chain) scan->xxx_ind_chain = xxx_ind_chain->seq_chain.next; else scan->xxx_ind_chain = xxx_ind_chain->ind_chain.next; } else { clause = var_clause; scan->var_ind_chain = var_ind_chain->ind_chain.next; } if (clause->cl_no >= scan->stop_cl_no) return NULL; if (clause->erase_stamp <= scan->erase_stamp) goto start; scan->clause = clause; return clause; } /*-------------------------------------------------------------------------* * PL_SCAN_DYNAMIC_PRED_ALT_0 * * * *-------------------------------------------------------------------------*/ PlLong Pl_Scan_Dynamic_Pred_Alt_0(void) { WamWord *alt_info; DynScan *scan; DynCInf *clause; Bool is_last; WamWord *adr; int i; CodePtr scan_alt; scan_alt = ALTB(B); Pl_Update_Choice_Point(scan_alt, 0); i = (sizeof(DynScan) + sizeof(WamWord) - 1) / sizeof(WamWord) - 1; scan = (DynScan *) &AB(B, i); adr = (WamWord *) scan; alt_info = (WamWord *) (adr - scan->alt_size_info); clause = scan->clause; is_last = (Scan_Dynamic_Pred_Next(scan) == NULL); if (is_last) Delete_Last_Choice_Point(); return (*scan->alt_fct) (clause, alt_info /*, is_last*/); /* nobody needs is_last for the moment */ } /*-------------------------------------------------------------------------* * PL_SCAN_CHOICE_POINT_PRED * * * * returns the module and initializes the functor and arity of the owner * * of the scan choice point b. returns -1 if b is not a scan choice point. * *-------------------------------------------------------------------------*/ int Pl_Scan_Choice_Point_Pred(WamWord *b, int *func, int *arity) { DynScan *scan; scan = Get_Scan_Choice_Point(b); if (scan == NULL) return -1; *func = scan->owner_func; *arity = scan->owner_arity; return scan->owner_module; } /*-------------------------------------------------------------------------* * PL_COPY_CLAUSE_TO_HEAP * * * *-------------------------------------------------------------------------*/ void Pl_Copy_Clause_To_Heap(DynCInf *clause, WamWord *head_word, WamWord *body_word) { Pl_Copy_Contiguous_Term(H, &clause->term_word); /* *H=<LST,H+1> */ *head_word = H[1]; *body_word = H[2]; H += clause->term_size; } #if defined(DEBUG) || defined(DEBUG1) /*-------------------------------------------------------------------------* * CHECK_DYNAMIC_CLAUSES * * * * (debug function) * *-------------------------------------------------------------------------*/ static void Check_Dynamic_Clauses(DynPInf *dyn) { DBGPRINTF("\nFirst dyn with erase:%p\n", first_dyn_with_erase); DBGPRINTF("Dyn:%p arity:%d count_a:%d count_z:%d " "1st erased:%p next dyn with erase:%p\n", dyn, dyn->arity, dyn->count_a, dyn->count_z, dyn->first_erased_cl, dyn->next_dyn_with_erase); Check_Chain(&dyn->seq_chain, NO_INDEX); Check_Chain(&dyn->var_ind_chain, VAR_INDEX); Check_Hash(dyn->atm_htbl, ATM_INDEX); Check_Hash(dyn->int_htbl, INT_INDEX); Check_Chain(&dyn->lst_ind_chain, LST_INDEX); Check_Hash(dyn->stc_htbl, STC_INDEX); } /*-------------------------------------------------------------------------* * CHECK_HASH * * * * (debug function) * *-------------------------------------------------------------------------*/ static void Check_Hash(char *t, int index_no) { DSwtInf *swt; HashScan scan; if (t == NULL) return; switch (index_no) { case ATM_INDEX: DBGPRINTF("\nAtom\n"); break; case INT_INDEX: DBGPRINTF("\nInteger\n"); break; case STC_INDEX: DBGPRINTF("\nStructure\n"); break; } for (swt = (DSwtInf *) Pl_Hash_First(t, &scan); swt; swt = (DSwtInf *) Pl_Hash_Next(&scan)) { if (index_no == ATM_INDEX) DBGPRINTF("val <%s>\n", pl_atom_tbl[swt->key].name); if (index_no == INT_INDEX) DBGPRINTF("val <%" PL_FMT_d ">\n", swt->key); if (index_no == STC_INDEX) DBGPRINTF("val <%s/%d>\n", pl_atom_tbl[Functor_Of(swt->key)].name, (int) Arity_Of(swt->key)); Check_Chain(&swt->ind_chain, index_no); } } /*-------------------------------------------------------------------------* * CHECK_LIST * * * * (debug function) * *-------------------------------------------------------------------------*/ static void Check_Chain(D2ChHdr *hdr, int index_no) { DynCInf *clause, *clause_b, *clause_f; if (hdr->first == NULL) return; switch (index_no) { case NO_INDEX: DBGPRINTF("\nSequential\n"); break; case VAR_INDEX: DBGPRINTF("\nVariable\n"); break; case LST_INDEX: DBGPRINTF("\nList\n"); break; } for(clause = hdr->first; clause; clause = clause_f) { clause_f = clause_b = NULL; if (index_no == NO_INDEX) { clause_f = clause->seq_chain.next; clause_b = clause->seq_chain.prev; } else { clause_f = clause->ind_chain.next; clause_b = clause->ind_chain.prev; } DBGPRINTF(" %3d %3d %p %p <-> %p ", clause->cl_no, clause->term_size, clause, clause_b, clause_f); Pl_Write(clause->head_word); DBGPRINTF(":-"); Pl_Write(clause->body_word); if (clause->erase_stamp != DYN_STAMP_NONE) DBGPRINTF(" erased at:%" PL_FMT_d " next erased: %p", clause->erase_stamp, (clause->next_erased_cl)); DBGPRINTF("\n"); } } #endif ���������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pred_supp.c����������������������������������������������������������������0000644�0001750�0001750�00000013717�13021324543�015455� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pred_supp.c * * Descr.: predicate management support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <string.h> #include <ctype.h> #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define AUX_STR "_$aux" /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ /*-------------------------------------------------------------------------* * PL_DETECT_IF_AUX_NAME * * * * returns NULL if not an aux name or a pointer to / before the arity of * * the father. * *-------------------------------------------------------------------------*/ char * Pl_Detect_If_Aux_Name(int func) { char *str = pl_atom_tbl[func].name; char *p, *q; if (*str != '$' || (p = strstr(str, AUX_STR)) == NULL) return NULL; q = p + sizeof(AUX_STR) - 1; if (!isdigit(*q)) return NULL; while (isdigit(*++q)) ; if (*q != '\0') return NULL; while (isdigit(*--p) && p > str) ; if (*p != '/') return NULL; return p; } /*-------------------------------------------------------------------------* * PL_FATHER_PRED_OF_AUX * * * * returns -1 if it is not an aux predicate name. * *-------------------------------------------------------------------------*/ int Pl_Father_Pred_Of_Aux(int func, int *father_arity) { char *p; int l; p = Pl_Detect_If_Aux_Name(func); if (p == NULL) return -1; l = p - pl_atom_tbl[func].name; *father_arity = strtol(p + 1, NULL, 10); strcpy(pl_glob_buff, pl_atom_tbl[func].name + 1); /* skip 1st $ */ pl_glob_buff[l - 1] = '\0'; return Pl_Create_Allocate_Atom(pl_glob_buff); } /*-------------------------------------------------------------------------* * PL_PRED_WITHOUT_AUX * * * *-------------------------------------------------------------------------*/ int Pl_Pred_Without_Aux(int func, int arity, int *arity1) { int func1; func1 = Pl_Father_Pred_Of_Aux(func, arity1); if (func1 < 0) { *arity1 = arity; func1 = func; } return func1; } /*-------------------------------------------------------------------------* * PL_MAKE_AUX_NAME * * * *-------------------------------------------------------------------------*/ int Pl_Make_Aux_Name(int func, int arity, int aux_nb) { func = Pl_Pred_Without_Aux(func, arity, &arity); sprintf(pl_glob_buff, "$%s/%d%s%d", pl_atom_tbl[func].name, arity, AUX_STR, aux_nb); return Pl_Create_Allocate_Atom(pl_glob_buff); } �������������������������������������������������gprolog-1.4.5/src/BipsPl/type_inl.wam���������������������������������������������������������������0000644�0001750�0001750�00000005270�13021356407�015640� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : type_inl.pl file_name('/home/diaz/GP/src/BipsPl/type_inl.pl'). predicate(system:'$use_type_inl'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:var/1,44,static,private,monofile,built_in,[ call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), proceed]). predicate(system:nonvar/1,47,static,private,monofile,built_in,[ call_c('Pl_Blt_Non_Var',[fast_call,boolean],[x(0)]), proceed]). predicate(system:atom/1,50,static,private,monofile,built_in,[ call_c('Pl_Blt_Atom',[fast_call,boolean],[x(0)]), proceed]). predicate(system:integer/1,53,static,private,monofile,built_in,[ call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), proceed]). predicate(system:float/1,56,static,private,monofile,built_in,[ call_c('Pl_Blt_Float',[fast_call,boolean],[x(0)]), proceed]). predicate(system:number/1,59,static,private,monofile,built_in,[ call_c('Pl_Blt_Number',[fast_call,boolean],[x(0)]), proceed]). predicate(system:atomic/1,62,static,private,monofile,built_in,[ call_c('Pl_Blt_Atomic',[fast_call,boolean],[x(0)]), proceed]). predicate(system:compound/1,65,static,private,monofile,built_in,[ call_c('Pl_Blt_Compound',[fast_call,boolean],[x(0)]), proceed]). predicate(system:callable/1,68,static,private,monofile,built_in,[ call_c('Pl_Blt_Callable',[fast_call,boolean],[x(0)]), proceed]). predicate(system:ground/1,71,static,private,monofile,built_in,[ call_c('Pl_Blt_Ground',[fast_call,boolean],[x(0)]), proceed]). predicate(system:is_list/1,74,static,private,monofile,built_in,[ call_c('Pl_Blt_List',[fast_call,boolean],[x(0)]), proceed]). predicate(system:list/1,77,static,private,monofile,built_in,[ call_c('Pl_Blt_List',[fast_call,boolean],[x(0)]), proceed]). predicate(system:partial_list/1,80,static,private,monofile,built_in,[ call_c('Pl_Blt_Partial_List',[fast_call,boolean],[x(0)]), proceed]). predicate(system:list_or_partial_list/1,83,static,private,monofile,built_in,[ call_c('Pl_Blt_List_Or_Partial_List',[fast_call,boolean],[x(0)]), proceed]). predicate(system:fd_var/1,89,static,private,monofile,built_in_fd,[ call_c('Pl_Blt_Fd_Var',[fast_call,boolean],[x(0)]), proceed]). predicate(system:non_fd_var/1,92,static,private,monofile,built_in_fd,[ call_c('Pl_Blt_Non_Fd_Var',[fast_call,boolean],[x(0)]), proceed]). predicate(system:generic_var/1,95,static,private,monofile,built_in_fd,[ call_c('Pl_Blt_Generic_Var',[fast_call,boolean],[x(0)]), proceed]). predicate(system:non_generic_var/1,98,static,private,monofile,built_in_fd,[ call_c('Pl_Blt_Non_Generic_Var',[fast_call,boolean],[x(0)]), proceed]). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/format.pl������������������������������������������������������������������0000644�0001750�0001750�00000006012�13021324543�015123� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : format.pl * * Descr.: formatted output management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_format'. %:- meta_predicate(format(+, :)). %why ? %:- meta_predicate(format(+, +, :)). format(Format, Args) :- set_bip_name(format, 2), '$call_c'('Pl_Format_2'(Format, Args)). format(SorA, Format, Args) :- set_bip_name(format, 3), '$call_c'('Pl_Format_3'(SorA, Format, Args)). ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/assert_c.c�����������������������������������������������������������������0000644�0001750�0001750�00000032664�13021324543�015261� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : assert_c.c * * Descr.: dynamic predicate management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static DynCInf *last_clause; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Clause_Alt(DynCInf *clause, WamWord *w); static Bool Retract_Alt(DynCInf *clause, WamWord *w); /*-------------------------------------------------------------------------* * PL_ASSERT_4 * * * *-------------------------------------------------------------------------*/ void Pl_Assert_4(WamWord clause_word, WamWord asserta_word, WamWord check_perm_word, WamWord pl_file_word) { WamWord head_word, body_word; int module; Bool asserta = Pl_Rd_Integer(asserta_word); Bool check_perm = Pl_Rd_Integer(check_perm_word); int pl_file = Pl_Rd_Atom(pl_file_word); module = Pl_Get_Head_And_Body_Top(clause_word, &head_word, &body_word); body_word = Pl_Term_To_Goal(body_word, module, NOT_A_WAM_WORD); last_clause = Pl_Add_Dynamic_Clause(module, head_word, body_word, asserta, check_perm, pl_file); } /*-------------------------------------------------------------------------* * RETRACT * * * *-------------------------------------------------------------------------*/ static Bool Retract(int module, WamWord head_word, WamWord body_word, Bool retractall) { WamWord word, tag_mask; WamWord *first_arg_adr; WamWord head_word1, body_word1; int func, arity; PredInf *pred; DynCInf *clause; WamWord w[2]; first_arg_adr = Pl_Rd_Callable_Check(head_word, &func, &arity); DEREF(body_word, word, tag_mask); body_word = word; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK && tag_mask != TAG_LST_MASK && tag_mask != TAG_STC_MASK) Pl_Err_Type(pl_type_callable, body_word); #ifdef DEBUG DBGPRINTF("retract(all)/1: arity: %d", arity); if (arity > 0) { DBGPRINTF("\tfirst arg: "); Pl_Write(*first_arg_adr); } DBGPRINTF("\n"); #endif if ((pred = Pl_Lookup_Pred(module, func, arity)) == NULL) return FALSE; if (!(pred->prop & MASK_PRED_DYNAMIC)) { /* dont use module here: can be != pred->mod->module (ex: foo:p/n can refer to user:p/n) */ word = Pl_Build_Pred_Indic_Error(pred); Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_static_procedure, word); } if (pred->dyn == NULL) /* no dynamic info */ return FALSE; if (arity > 0) word = *first_arg_adr; w[0] = head_word; w[1] = body_word; clause = Pl_Scan_Dynamic_Pred(pred, word, -1, -1, 0, (ScanFct) Retract_Alt, (retractall) ? DYN_ALT_FCT_FOR_FAIL : DYN_ALT_FCT_FOR_TEST, 2, w); if (clause == NULL) return FALSE; Pl_Copy_Clause_To_Heap(clause, &head_word1, &body_word1); if (!Pl_Unify(head_word, head_word1) || !Pl_Unify(body_word, body_word1)) return FALSE; Pl_Delete_Dynamic_Clause(clause); return TRUE; } /*-------------------------------------------------------------------------* * RETRACT_ALT * * * *-------------------------------------------------------------------------*/ static Bool Retract_Alt(DynCInf *clause, WamWord *w) { WamWord head_word1, body_word1; Pl_Copy_Clause_To_Heap(clause, &head_word1, &body_word1); if (!Pl_Unify(head_word1, w[0]) || !Pl_Unify(body_word1, w[1])) return FALSE; Pl_Delete_Dynamic_Clause(clause); return TRUE; } /*-------------------------------------------------------------------------* * PL_RETRACT_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Retract_1(WamWord clause_word) { WamWord head_word, body_word; int module; module = Pl_Get_Head_And_Body_Top(clause_word, &head_word, &body_word); return Retract(module, head_word, body_word, FALSE); } /*-------------------------------------------------------------------------* * PL_RETRACTALL_1 * * * *-------------------------------------------------------------------------*/ void Pl_Retractall_1(WamWord head_word) { WamWord word, tag_mask; WamWord *adr; WamWord *arg_adr; int module, func, arity; PredInf *pred; WamWord *ref_adr[MAX_ARITY]; int i, j; Bool all_singleton; module = Pl_Strip_Module_Top(head_word, FALSE, TRUE, &head_word); arg_adr = Pl_Rd_Callable_Check(head_word, &func, &arity); /* if pred does not exist, retractall implicitly creates it as a dynamic pred. */ if ((pred = Pl_Lookup_Pred(module, func, arity)) == NULL) pred = Pl_Create_Dynamic_Pred(module, func, arity); if (!(pred->prop & MASK_PRED_DYNAMIC)) { /* NB: module can be != pred->mod->module (ex: foo:p/n can refer to user:p/n) */ word = Pl_Build_Pred_Indic_Error(pred); Pl_Err_Permission(pl_permission_operation_modify, pl_permission_type_static_procedure, word); } all_singleton = TRUE; /* check if all args are singleton variables */ for (i = 0; i < arity; i++) { DEREF(*arg_adr, word, tag_mask); if (tag_mask != TAG_REF_MASK) { all_singleton = FALSE; /* not a var */ break; } adr = UnTag_REF(word); ref_adr[i] = adr; *adr = Tag_INT(0); /* patch the argument to an INT */ arg_adr++; } j = i; for (i = 0; i < j; i++) /* restore the args */ { adr = ref_adr[i]; *adr = Make_Self_Ref(adr); } if (all_singleton) { Pl_Update_Dynamic_Pred(module, func, arity, 1, -1); /* remove all clauses for this pred */ return; } Retract(module, head_word, Pl_Put_X_Variable(), TRUE); /* act like retract(p(...)), fail (failure in assert.pl) */ } /*-------------------------------------------------------------------------* * PL_CLAUSE_3 * * * * check_public = TRUE for for clause/2 (ie. error if not public) * * = FALSE for listing/1 (no check if public) * * NB: listing/1 tests before it is not native_code * *-------------------------------------------------------------------------*/ Bool Pl_Clause_3(WamWord head_word, WamWord body_word, WamWord check_public_word) { WamWord word, tag_mask; WamWord *first_arg_adr; WamWord head_word1, body_word1; int module, func, arity; PredInf *pred; DynCInf *clause; WamWord w[2]; Bool check_public = Pl_Rd_Boolean(check_public_word); module = Pl_Strip_Module_Top(head_word, FALSE, TRUE, &head_word); first_arg_adr = Pl_Rd_Callable_Check(head_word, &func, &arity); DEREF(body_word, word, tag_mask); body_word = word; if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK && tag_mask != TAG_LST_MASK && tag_mask != TAG_STC_MASK) Pl_Err_Type(pl_type_callable, body_word); #ifdef DEBUG DBGPRINTF("clause/2: arity: %d", arity); if (arity > 0) { DBGPRINTF("\tfirst arg: "); Pl_Write(*first_arg_adr); } DBGPRINTF("\n"); #endif if ((pred = Pl_Lookup_Pred_Visible(module, func, arity)) == NULL) return FALSE; if (check_public && !(pred->prop & MASK_PRED_PUBLIC)) { word = Pl_Build_Pred_Indic_Error(pred); Pl_Err_Permission(pl_permission_operation_access, pl_permission_type_private_procedure, word); } if (pred->dyn == NULL) /* no dynamic info */ return FALSE; if (arity > 0) word = *first_arg_adr; w[0] = head_word; w[1] = body_word; clause = Pl_Scan_Dynamic_Pred(pred, word, -1, -1, 0, (ScanFct) Clause_Alt, DYN_ALT_FCT_FOR_TEST, 2, w); if (clause == NULL) return FALSE; Pl_Copy_Clause_To_Heap(clause, &head_word1, &body_word1); last_clause = clause; return Pl_Unify(head_word, head_word1) && Pl_Unify(body_word, body_word1); } /*-------------------------------------------------------------------------* * CLAUSE_ALT * * * *-------------------------------------------------------------------------*/ static Bool Clause_Alt(DynCInf *clause, WamWord *w) { WamWord head_word1, body_word1; Pl_Copy_Clause_To_Heap(clause, &head_word1, &body_word1); last_clause = clause; return Pl_Unify(head_word1, w[0]) && Pl_Unify(body_word1, w[1]); } #if 0 /* OLD CODE */ /*-------------------------------------------------------------------------* * PL_RETRACT_LAST_FOUND_0 * * * *-------------------------------------------------------------------------*/ void Pl_Retract_Last_Found_0(void) { Pl_Delete_Dynamic_Clause(last_clause); } /*-------------------------------------------------------------------------* * SETARG_OF_LAST_FOUND_2 * * * * update in place the ArgNo th argument of last_clause. NewValue must be * * a 1-tagged word data (atom, integer). * *-------------------------------------------------------------------------*/ void Pl_Setarg_Of_Last_Found_2(WamWord arg_no_word, WamWord new_value_word) { WamWord word, tag_mask; WamWord *adr; int arg_no; arg_no = Pl_Rd_Integer(arg_no_word) - 1; DEREF(last_clause->head_word, word, tag_mask); adr = UnTag_Address(word); DEREF(new_value_word, word, tag_mask); Arg(adr, arg_no) = word; } #endif /*-------------------------------------------------------------------------* * PL_ABOLISH_1 * * * *-------------------------------------------------------------------------*/ void Pl_Abolish_1(WamWord pred_indic_word) { int module, func, arity; module = Pl_Get_Pred_Indicator_Top(pred_indic_word, FALSE, &func, &arity); Pl_Update_Dynamic_Pred(module, func, arity, 3, -1); } ����������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/term_supp.c����������������������������������������������������������������0000644�0001750�0001750�00000120342�13021324543�015463� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : term_supp.c * * Descr.: term support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <string.h> #define OBJ_INIT Term_Supp_Initializer #define TERM_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /* copy term variables */ static WamWord *base_copy; static WamWord vars[MAX_VAR_IN_TERM * 2]; /* needs 2 words for a variable */ static WamWord *end_vars = vars + MAX_VAR_IN_TERM * 2; static WamWord *top_vars; /* term to goal variables */ static WamWord t2g_term_word; static WamWord t2g_module_word; static WamWord t2g_call_info_word; /* atoms */ static int atom_call; static int atom_call_internal; static int atom_clause; static int atom_if; static int atom_soft_if; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Copy_Term_Rec(WamWord *dst_adr, WamWord *src_adr, WamWord **p); static Bool Term_Hash(WamWord start_word, PlLong depth, unsigned *hash); static Bool Term_Hash_Rec(WamWord start_word, PlLong depth, HashIncrInfo *hi); /*-------------------------------------------------------------------------* * TERM_SUPP_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Term_Supp_Initializer(void) { atom_call = Pl_Create_Atom("call"); atom_call_internal = Pl_Create_Atom("$call_internal"); atom_clause = Pl_Create_Atom(":-"); atom_if = Pl_Create_Atom("->"); atom_soft_if = Pl_Create_Atom("*->"); } /*-------------------------------------------------------------------------* * PL_TERM_COMPARE * * * *-------------------------------------------------------------------------*/ PlLong Pl_Term_Compare(WamWord start_u_word, WamWord start_v_word) { WamWord u_word, u_tag_mask; WamWord v_word, v_tag_mask; WamWord u_tag, v_tag; int u_func, u_arity; WamWord *u_arg_adr; int v_func, v_arity; WamWord *v_arg_adr; int i, x; double d1, d2; DEREF(start_u_word, u_word, u_tag_mask); DEREF(start_v_word, v_word, v_tag_mask); u_tag = Tag_From_Tag_Mask(u_tag_mask); v_tag = Tag_From_Tag_Mask(v_tag_mask); switch (u_tag) { case REF: return (v_tag != REF) ? -1 : UnTag_REF(u_word) - UnTag_REF(v_word); #ifndef NO_USE_FD_SOLVER case FDV: if (v_tag == REF) return 1; return (v_tag != FDV) ? -1 : UnTag_FDV(u_word) - UnTag_FDV(v_word); #endif case FLT: if (v_tag == REF #ifndef NO_USE_FD_SOLVER || v_tag == FDV #endif ) return 1; if (v_tag != FLT) return -1; d1 = Pl_Obtain_Float(UnTag_FLT(u_word)); d2 = Pl_Obtain_Float(UnTag_FLT(v_word)); return (d1 < d2) ? -1 : (d1 == d2) ? 0 : 1; case INT: if (v_tag == REF || #ifndef NO_USE_FD_SOLVER v_tag == FDV || #endif v_tag == FLT) return 1; return (v_tag != INT) ? -1 : UnTag_INT(u_word) - UnTag_INT(v_word); case ATM: if (v_tag == REF || #ifndef NO_USE_FD_SOLVER v_tag == FDV || #endif v_tag == FLT || v_tag == INT) return 1; return (v_tag != ATM) ? -1 : strcmp(pl_atom_tbl[UnTag_ATM(u_word)].name, pl_atom_tbl[UnTag_ATM(v_word)].name); } /* u_tag == LST / STC */ v_arg_adr = Pl_Rd_Compound(v_word, &v_func, &v_arity); if (v_arg_adr == NULL) /* v_tag != LST / STC */ return 1; u_arg_adr = Pl_Rd_Compound(u_word, &u_func, &u_arity); if (u_arity != v_arity) return u_arity - v_arity; if (u_func != v_func) return strcmp(pl_atom_tbl[u_func].name, pl_atom_tbl[v_func].name); for (i = 0; i < u_arity; i++) if ((x = Pl_Term_Compare(*u_arg_adr++, *v_arg_adr++)) != 0) return x; return 0; } /*-------------------------------------------------------------------------* * PL_TREAT_VARS_OF_TERM * * * * Call fct for each variable found in a term. * *-------------------------------------------------------------------------*/ Bool Pl_Treat_Vars_Of_Term(WamWord start_word, Bool generic_var, Bool (*fct) ()) { WamWord word, tag_mask; WamWord *adr; int i; terminal_rec: DEREF(start_word, word, tag_mask); switch (Tag_Of(word)) { case REF: if (!(*fct) (UnTag_REF(word), word)) return FALSE; break; #ifndef NO_USE_FD_SOLVER case FDV: if (generic_var) if (!(*fct) (UnTag_FDV(word), word)) return FALSE; break; #endif case LST: adr = UnTag_LST(word); adr = &Car(adr); if (!Pl_Treat_Vars_Of_Term(*adr++, generic_var, fct)) return FALSE; start_word = *adr; goto terminal_rec; case STC: adr = UnTag_STC(word); i = Arity(adr); adr = &Arg(adr, 0); while (--i) if (!Pl_Treat_Vars_Of_Term(*adr++, generic_var, fct)) return FALSE; start_word = *adr; goto terminal_rec; } return TRUE; } /*-------------------------------------------------------------------------* * PL_LIST_LENGTH * * * * returns the length of a list or < 0 if not a list: * * -1: instantation error * * -2: type error (type_list) * *-------------------------------------------------------------------------*/ int Pl_List_Length(WamWord start_word) { WamWord word, tag_mask; int n = 0; for (;;) { DEREF(start_word, word, tag_mask); if (word == NIL_WORD) return n; if (tag_mask == TAG_REF_MASK) return -1; if (tag_mask != TAG_LST_MASK) return -2; n++; start_word = Cdr(UnTag_LST(word)); } } /*-------------------------------------------------------------------------* * PL_TERM_SIZE * * * *-------------------------------------------------------------------------*/ int Pl_Term_Size(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; int i; int n = 0; /* init to zero for terminal_rec */ terminal_rec: DEREF(start_word, word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { #ifndef NO_USE_FD_SOLVER case FDV: /* 1+ for <REF,->fdv_adr> since Dont_Separate_Tag */ return n + 1 + Fd_Variable_Size(UnTag_FDV(word)); #endif case FLT: #if WORD_SIZE == 32 return n + 1 + 2; #else return n + 1 + 1; #endif case LST: adr = UnTag_LST(word); adr = &Car(adr); n += 1 + Pl_Term_Size(*adr++); start_word = *adr; goto terminal_rec; case STC: adr = UnTag_STC(word); n += 2; /* tagged word + f_n */ i = Arity(adr); adr = &Arg(adr, 0); while (--i) n += Pl_Term_Size(*adr++); start_word = *adr; goto terminal_rec; default: return n + 1; } } /*-------------------------------------------------------------------------* * PL_COPY_TERM * * * * Copy a non contiguous term, the result is a contiguous term. * *-------------------------------------------------------------------------*/ void Pl_Copy_Term(WamWord *dst_adr, WamWord *src_adr) { WamWord *qtop, *base; WamWord *p; /* fix_bug is because when gcc sees &xxx where xxx is a fct argument variable * it allocates a frame even with -fomit-frame-pointer. * This corrupts ebp on ix86 */ static WamWord *fix_bug; base_copy = dst_adr++; base = top_vars = vars; fix_bug = dst_adr; Copy_Term_Rec(base_copy, src_adr, &fix_bug); /* restore original self references */ qtop = top_vars; while (qtop != base) { p = (WamWord *) (*--qtop); /* address to restore */ *p = *--qtop; /* word to restore */ } } /*-------------------------------------------------------------------------* * COPY_TERM_REC * * * * p is the next address to use to store the rest of a term. * *-------------------------------------------------------------------------*/ static void Copy_Term_Rec(WamWord *dst_adr, WamWord *src_adr, WamWord **p) { WamWord word, tag_mask; WamWord *adr; WamWord *q; int i; terminal_rec: DEREF(*src_adr, word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { case REF: adr = UnTag_REF(word); q = *p; if (adr < q && adr >= base_copy) /* already a copy */ { *dst_adr = word; return; } if (top_vars >= end_vars) Pl_Err_Representation(pl_representation_too_many_variables); *top_vars++ = word; /* word to restore */ *top_vars++ = (WamWord) adr; /* address to restore */ *adr = *dst_adr = Tag_REF(dst_adr); /* bind to a new copy */ return; #ifndef NO_USE_FD_SOLVER case FDV: adr = UnTag_FDV(word); q = *p; if (adr < q && adr >= base_copy) /* already a copy */ { *dst_adr = Tag_REF(adr); /* since Dont_Separate_Tag */ return; } if (top_vars >= end_vars) Pl_Err_Representation(pl_representation_too_many_variables); *top_vars++ = word; /* word to restore */ *top_vars++ = (WamWord) adr; /* address to restore */ q = *p; *p = q + Fd_Copy_Variable(q, adr); *adr = *dst_adr = Tag_REF(q); /* bind to a new copy */ return; #endif case FLT: adr = UnTag_FLT(word); q = *p; q[0] = adr[0]; #if WORD_SIZE == 32 q[1] = adr[1]; *p = q + 2; #else *p = q + 1; #endif *dst_adr = Tag_FLT(q); return; case LST: adr = UnTag_LST(word); q = *p; *dst_adr = Tag_LST(q); *p = &Cdr(q) + 1; q = &Car(q); adr = &Car(adr); Copy_Term_Rec(q++, adr++, p); dst_adr = q; src_adr = adr; goto terminal_rec; case STC: adr = UnTag_STC(word); q = *p; *dst_adr = Tag_STC(q); Functor_And_Arity(q) = Functor_And_Arity(adr); i = Arity(adr); *p = &Arg(q, i - 1) + 1; q = &Arg(q, 0); adr = &Arg(adr, 0); while (--i) Copy_Term_Rec(q++, adr++, p); dst_adr = q; src_adr = adr; goto terminal_rec; default: *dst_adr = word; return; } } /*-------------------------------------------------------------------------* * PL_COPY_CONTIGUOUS_TERM * * * * Copy a contiguous term (dereferenced), the result is a contiguous term. * *-------------------------------------------------------------------------*/ void Pl_Copy_Contiguous_Term(WamWord *dst_adr, WamWord *src_adr) #define Old_Adr_To_New_Adr(adr) ((dst_adr) + ((adr) - (src_adr))) { WamWord word, *adr; WamWord *q; int i; terminal_rec: word = *src_adr; switch (Tag_Of(word)) { case REF: adr = UnTag_REF(word); q = Old_Adr_To_New_Adr(adr); *dst_adr = Tag_REF(q); if (adr > src_adr) /* only useful for Dont_Separate_Tag */ Pl_Copy_Contiguous_Term(q, adr); return; #ifndef NO_USE_FD_SOLVER case FDV: adr = UnTag_FDV(word); Fd_Copy_Variable(dst_adr, adr); return; #endif case FLT: adr = UnTag_FLT(word); q = Old_Adr_To_New_Adr(adr); q[0] = adr[0]; #if WORD_SIZE == 32 q[1] = adr[1]; #endif *dst_adr = Tag_FLT(q); return; case LST: adr = UnTag_LST(word); q = Old_Adr_To_New_Adr(adr); *dst_adr = Tag_LST(q); q = &Car(q); adr = &Car(adr); Pl_Copy_Contiguous_Term(q++, adr++); dst_adr = q; src_adr = adr; goto terminal_rec; case STC: adr = UnTag_STC(word); q = Old_Adr_To_New_Adr(adr); *dst_adr = Tag_STC(q); Functor_And_Arity(q) = Functor_And_Arity(adr); i = Arity(adr); q = &Arg(q, 0); adr = &Arg(adr, 0); while (--i) Pl_Copy_Contiguous_Term(q++, adr++); dst_adr = q; src_adr = adr; goto terminal_rec; default: *dst_adr = word; return; } } #if 0 /*-------------------------------------------------------------------------* * PL_ACYCLIC_TERM_1 * * * * This implementation is not very satisfactory because: * * - it does not handle terminal recursion (useful for lists). * * - it does not take into account sharing. * * However, it is simple and enough until a full support for cyclic term * * is implemented (at least in the unification). * *-------------------------------------------------------------------------*/ Bool Pl_Acyclic_Term_1(WamWord start_word) #define MARK Tag_LST(0) { WamWord word, tag_mask; WamWord word1; WamWord *adr; int arity; Bool ret; DEREF(start_word, word, tag_mask); if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); arity = 2; adr = &Car(adr); } else if (tag_mask == TAG_STC_MASK) { adr = UnTag_STC(word); arity = Arity(adr); adr = &Arg(adr, 0); } else return TRUE; while (--arity >= 0) { word1 = *adr; DEREF(word1, word, tag_mask); if (word == MARK) /* marked = cyclic */ return FALSE; if (tag_mask == TAG_LST_MASK || tag_mask == TAG_STC_MASK) { *adr = MARK; /* mark it */ ret = Pl_Acyclic_Term_1(word1); *adr = word1; /* unmark it */ if (!ret) return FALSE; } adr++; } return TRUE; } #else /*-------------------------------------------------------------------------* * PL_ACYCLIC_TERM_1 * * * * This is implemented in linear time markink each sub-term (LST or STC) * * with a special mark (NB we cannot use NOT_A_WAM_WORD, <REF,0> since it * * would be dereferenced. So we use <LST,0> * * * * This implementation no longer uses the C-stack for recursion. * * Instead it uses the heap (could be another stack). * * The acyclic stack records both the mark to undo and the terms to check. * * * * save/restore record: * * | .................. | <- sp * * | adr to restore | 1 | bit0 = 1 for this kind of entry * * | value to restore | * * * * term to check record: * * | .................. | <- sp * * | adr to check | bit0 = 0 for this kind of entry * * | arity remaining | nb of arguments to be checked (at adr; adr+1,...)* * * * NB, this implementation does not take into account sharing. This could * * be done with another mark (eg. <LST,1>) to indicate that a term has been* * checked and it is cycle-free. When this mark is encountered, it is not * * necessary to check it again. At the end, these marked words are also * * restored. However, handling shareing requires more memory. * * Anyway, the current simple and enough until a full support for cyclic * * terms is implemented, at least in the unification: X=f(X), Y=f(Y), X=Y. * *-------------------------------------------------------------------------*/ Bool Pl_Acyclic_Term_1(WamWord start_word) #define CYCLIC_MARK Tag_LST(0) { WamWord word, tag_mask; WamWord *adr; WamWord *adr1; int arity; Bool ok = TRUE; WamWord *mark_base = H; WamWord *mark_sp = mark_base; *mark_sp++ = (WamWord) 1; /* arity */ *mark_sp++ = (WamWord) &start_word; /* addr to check */ #if 0 #define DEBUG #endif #ifdef DEBUG DBGPRINTF("+++ START test acyclic_term %p = %lx\n", &start_word, start_word); #endif while (mark_sp > mark_base) { word = mark_sp[-1]; if (word & 1) /* a restore operation */ { word = (word >> 1) << 1; adr = (WamWord *) word; word = mark_sp[-2]; *adr = word; #ifdef DEBUG DBGPRINTF("restore addr %p = %lx ", adr, word); if (ok) Pl_Write(word); DBGPRINTF("\n"); #endif pop_and_cont: mark_sp -= 2; continue; } if (!ok) goto pop_and_cont; adr = (WamWord *) word; start_word = *adr; #ifdef DEBUG DBGPRINTF("check addr %p = %lx (after this it remains %ld args to check in this structure)\n", adr, start_word, mark_sp[-2]); #endif if (--mark_sp[-2] == 0) mark_sp -= 2; /* pop since last arg */ else mark_sp[-1] = (WamWord) (adr + 1); DEREF(start_word, word, tag_mask); if (word == CYCLIC_MARK) /* marked = cyclic */ { ok = FALSE; #ifdef DEBUG DBGPRINTF("*** CYCLE DETECTED ***\n"); #endif continue; } if (tag_mask == TAG_LST_MASK) { adr1 = UnTag_LST(word); arity = 2; adr1 = &Car(adr1); } else if (tag_mask == TAG_STC_MASK) { adr1 = UnTag_STC(word); arity = Arity(adr1); adr1 = &Arg(adr1, 0); } else continue; *mark_sp++ = (WamWord) start_word; *mark_sp++ = (WamWord) adr | 1; #ifdef DEBUG DBGPRINTF("save addr %p = %lx\n", adr, start_word); //Pl_Write(word); #endif *adr = CYCLIC_MARK; /* mark it */ *mark_sp++ = (WamWord) arity; *mark_sp++ = (WamWord) adr1; #ifdef DEBUG DBGPRINTF("push: to check addr %p arity: %d\n", adr1, arity); #endif } #ifdef DEBUG DBGPRINTF("+++ END test acyclic: addr %p = %lx result: %s\n", &start_word, start_word, (ok) ? "OK": "CYCLIC"); #endif return ok; } #endif /*-------------------------------------------------------------------------* * TERM_HASH * * * *-------------------------------------------------------------------------*/ static Bool Term_Hash(WamWord start_word, PlLong depth, unsigned *hash) { HashIncrInfo hi; Pl_Hash_Incr_Init(&hi); if (depth != 0 && !Term_Hash_Rec(start_word, depth, &hi)) return FALSE; *hash = Pl_Hash_Incr_Term(&hi); return TRUE; } /*-------------------------------------------------------------------------* * TERM_HASH_REC * * * *-------------------------------------------------------------------------*/ static Bool Term_Hash_Rec(WamWord start_word, PlLong depth, HashIncrInfo *hi) { WamWord word, tag_mask; WamWord *adr; int func, arity; terminal_rec: /* here depth is != 0 this is checked before (recursive) call */ /* NB: the depth-- should be done inside the terminal_rec label (not before !) * here it is only done for lists and structures (since atomic terms do not need it) */ DEREF(start_word, word, tag_mask); switch (Tag_From_Tag_Mask(tag_mask)) { case REF: #ifndef NO_USE_FD_SOLVER case FDV: #endif return FALSE; case ATM: Pl_Hash_Incr_Int32(hi, pl_atom_tbl[UnTag_ATM(word)].hash); break; case INT: Pl_Hash_Incr_Int64(hi, UnTag_INT(word)); break; case FLT: Pl_Hash_Incr_Double(hi, Pl_Obtain_Float(UnTag_FLT(word))); break; /* For faster list hasing we simply hash Car and then Cdr * h([a,b]) != h([a,[b]]) since h(a), h(b), h([]) != h(a), h(b), h([]), h([]) * NB: if depth == 0 (stop hashing) we hash '.' / 2 */ case LST: if (--depth == 0) { Pl_Hash_Incr_Int32(hi, pl_atom_tbl[ATOM_CHAR('.')].hash); Pl_Hash_Incr_Int32(hi, 2); break; } adr = UnTag_LST(word); if (!Term_Hash_Rec(Car(adr), depth, hi)) return FALSE; start_word = Cdr(adr); goto terminal_rec; case STC: adr = UnTag_STC(word); func = Functor(adr); arity = Arity(adr); /* do not hash the word <f/n> since it is runtime dependent */ Pl_Hash_Incr_Int32(hi, pl_atom_tbl[func].hash); Pl_Hash_Incr_Int32(hi, arity); if (--depth == 0) break; adr = &Arg(adr, 0); while(--arity) { if (!Term_Hash_Rec(*adr++, depth, hi)) return FALSE; } start_word = *adr; goto terminal_rec; } return TRUE; } /*-------------------------------------------------------------------------* * PL_TERM_HASH_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Hash_4(WamWord start_word, WamWord depth_word, WamWord range_word, WamWord hash_word) { PlLong depth = Pl_Rd_Integer_Check(depth_word); PlLong range = Pl_Rd_Positive_Check(range_word); unsigned hash; if (range <= 0 || range > HASH_MOD_VALUE) range = HASH_MOD_VALUE; Pl_Check_For_Un_Integer(hash_word); /* Term_Hash fails if the term is not ground, in that case leave hash_word unbound */ if (!Term_Hash(start_word, depth, &hash)) return TRUE; return Pl_Un_Integer(hash % range, hash_word); } /*-------------------------------------------------------------------------* * PL_TERM_HASH_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_Hash_2(WamWord start_word, WamWord hash_word) { return Pl_Term_Hash_4(start_word, Tag_INT(-1), Tag_INT(0), hash_word); } /*-------------------------------------------------------------------------* * PL_STRIP_MODULE * * * * Decompose a meta-term (qualified term): stop when no more (:)/2 or if * * the module part is not an atom (consume var if accept_var = TRUE) * * * * The remaining term forms the goal_word (dereferenced). * * * * Return: the module_word (dereferenced) (atom or var) or NOT_A_WAM_WORD * * * * The topmost module name is saved in pl_calling_module (if an atom) * * if it is not yet defined. See Pl_Unset_Calling_Module * *-------------------------------------------------------------------------*/ WamWord Pl_Strip_Module(WamWord start_word, Bool accept_var, Bool raise_error, WamWord *goal_word) { WamWord word, tag_mask; WamWord *adr; WamWord module_word = NOT_A_WAM_WORD; for(;;) { DEREF(start_word, word, tag_mask); *goal_word = word; if (tag_mask != TAG_STC_MASK) break; adr = UnTag_STC(word); if (Functor_And_Arity(adr) == Functor_Arity(ATOM_CHAR(':'), 2)) { DEREF(Arg(adr, 0), word, tag_mask); if (tag_mask == TAG_ATM_MASK) { eat_it: module_word = word; start_word = Arg(adr, 1); if (pl_calling_module < 0) /* see Pl_Unset_Calling_Module */ pl_calling_module = UnTag_ATM(word); /* keep the top-most module */ continue; } if (tag_mask == TAG_REF_MASK) { if (accept_var) goto eat_it; if (raise_error) Pl_Err_Instantiation(); break; } if (raise_error) Pl_Err_Type(pl_type_atom, word); break; } #ifdef META_TERM_HIDDEN if (Functor_And_Arity(adr) == Functor_Arity(pl_atom_meta_term, 1)) { word = Arg(adr, 1); /* 0 is the offset */ DEREF(word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) { module_word = word; start_word = Arg(adr, 2); continue; } } #endif break; } return module_word; } /*-------------------------------------------------------------------------* * PL_STRIP_MODULE_TOP * * * * Same as Pl_Strip_Module but initializes the calling module. * * * * Return: the module (-1 if var), and the goal * *-------------------------------------------------------------------------*/ int Pl_Strip_Module_Top(WamWord start_word, Bool accept_var, Bool raise_error, WamWord *goal_word) { WamWord module_word; Pl_Unset_Calling_Module(); module_word = Pl_Strip_Module(start_word, FALSE, TRUE, goal_word); /* normally called from meta-argument so module_word != NOT_A_WAM_WORD (qualified with module) */ if (module_word == NOT_A_WAM_WORD) return pl_atom_user; if (Tag_Mask_Of(module_word) == TAG_REF_MASK) return -1; return UnTag_ATM(module_word); } /*-------------------------------------------------------------------------* * PL_GET_PRED_INDICATOR * * * * Initializes the functor and arity of the predicate indicator. * * func and arity: -1 means a variable. * * Return the module (see Pl_Strip_Module) * *-------------------------------------------------------------------------*/ WamWord Pl_Get_Pred_Indicator(WamWord pred_indic_word, Bool accept_var, int *func, int *arity) { WamWord pred_indic_word1; WamWord module_word; WamWord word, tag_mask; PlLong arity1; module_word = Pl_Strip_Module(pred_indic_word, accept_var, TRUE, &pred_indic_word1); pl_pi_module_word = module_word; DEREF(pred_indic_word1, word, tag_mask); if (tag_mask == TAG_REF_MASK && !accept_var) Pl_Err_Instantiation(); if (!Pl_Get_Structure(ATOM_CHAR('/'), 2, pred_indic_word1)) { #if 0 /* no longer accept a callable when a predicate indicator is expected */ if (!Flag_Value(strict_iso) && Pl_Rd_Callable(word, func, arity) != NULL) return module_word; #endif Pl_Err_Type(pl_type_predicate_indicator, pred_indic_word); } pl_pi_name_word = Pl_Unify_Variable(); pl_pi_arity_word = Pl_Unify_Variable(); DEREF(pl_pi_name_word, word, tag_mask); if (accept_var && tag_mask == TAG_REF_MASK) *func = -1; else *func = Pl_Rd_Atom_Check(word); /* emit instantiation error if needed */ DEREF(pl_pi_arity_word, word, tag_mask); if (accept_var && tag_mask == TAG_REF_MASK) *arity = -1; else { /* use a PlLong for arity1 to avoid truncations */ arity1 = Pl_Rd_Positive_Check(pl_pi_arity_word); if (arity1 > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); *arity = arity1; } return module_word; } /*-------------------------------------------------------------------------* * PL_GET_PRED_INDICATOR_TOP * * * * Same as Pl_Get_Pred_Indicator but initializes the calling module. * * Return module, func and arity: -1 means a variable. * *-------------------------------------------------------------------------*/ int Pl_Get_Pred_Indicator_Top(WamWord pred_indic_word, Bool accept_var, int *func, int *arity) { WamWord module_word; Pl_Unset_Calling_Module(); module_word = Pl_Get_Pred_Indicator(pred_indic_word, accept_var, func, arity); /* normally called from meta-argument so module_word != NOT_A_WAM_WORD (qualified with module) */ if (module_word == NOT_A_WAM_WORD) return pl_atom_user; if (Tag_Mask_Of(module_word) == TAG_REF_MASK) return -1; return UnTag_ATM(module_word); } /*-------------------------------------------------------------------------* * PL_GET_PRED_INDIC_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Pred_Indic_5(WamWord pred_indic_word, WamWord default_module_word, WamWord module_word, WamWord func_word, WamWord arity_word) { int func, arity; Pl_Get_Pred_Indicator(pred_indic_word, FALSE, &func, &arity); if (pl_pi_module_word == NOT_A_WAM_WORD) pl_pi_module_word = default_module_word; return Pl_Unify(pl_pi_module_word, module_word) && Pl_Unify(pl_pi_name_word, func_word) && Pl_Unify(pl_pi_arity_word, arity_word); } /*-------------------------------------------------------------------------* * PL_GET_PRED_INDIC_VAR_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Pred_Indic_Var_5(WamWord pred_indic_word, WamWord default_module_word, WamWord module_word, WamWord func_word, WamWord arity_word) { int func, arity; Pl_Get_Pred_Indicator(pred_indic_word, TRUE, &func, &arity); if (pl_pi_module_word == NOT_A_WAM_WORD) pl_pi_module_word = default_module_word; return Pl_Unify(pl_pi_module_word, module_word) && Pl_Unify(pl_pi_name_word, func_word) && Pl_Unify(pl_pi_arity_word, arity_word); } /*-------------------------------------------------------------------------* * PL_GET_HEAD_AND_BODY * * * * Get the head and body of a clause. * * Accepts terms of the form M:Clause and M:Head:-Body * * Return the Module (or NOT_A_WAM_WORD), Head and Body. * * Head and Body are not checked for errors (callable,...). * *-------------------------------------------------------------------------*/ WamWord Pl_Get_Head_And_Body(WamWord clause_word, WamWord *head_word, WamWord *body_word) { WamWord module_word = Pl_Strip_Module(clause_word, FALSE, TRUE, &clause_word); WamWord module_word1; int func, arity; WamWord *adr = Pl_Rd_Callable_Check(clause_word, &func, &arity); if (func == atom_clause && arity == 2) { module_word1 = Pl_Strip_Module(adr[0], FALSE, TRUE, head_word); if (module_word1 == NOT_A_WAM_WORD || module_word == NOT_A_WAM_WORD || module_word1 == module_word) { *body_word = adr[1]; } else { *body_word = Pl_Put_Structure(ATOM_CHAR(':'), 2); Pl_Unify_Value(module_word); /* body has the module of the context */ Pl_Unify_Value(adr[1]); } if (module_word1 != NOT_A_WAM_WORD) module_word = module_word1; /* module of the clause = module of the head */ } else { *head_word = clause_word; *body_word = Tag_ATM(pl_atom_true); } return module_word; } /*-------------------------------------------------------------------------* * PL_GET_HEAD_AND_BODY_TOP * * * * Same as Pl_Get_Head_And_Body but initializes the calling module. * * Return the module (never -1), head_word and body_word. * *-------------------------------------------------------------------------*/ int Pl_Get_Head_And_Body_Top(WamWord clause_word, WamWord *head_word, WamWord *body_word) { WamWord module_word; Pl_Unset_Calling_Module(); module_word = Pl_Get_Head_And_Body(clause_word, head_word, body_word); /* normally called from meta-argument so module_word != NOT_A_WAM_WORD (qualified with module) */ if (module_word == NOT_A_WAM_WORD) return pl_atom_user; return UnTag_ATM(module_word); } /*-------------------------------------------------------------------------* * PL_GET_HEAD_AND_BODY_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Head_And_Body_4(WamWord clause_word, WamWord module_word, WamWord head_word, WamWord body_word) { WamWord module_word1, head_word1, body_word1; module_word1 = Pl_Get_Head_And_Body(clause_word, &head_word1, &body_word1); return (module_word1 == NOT_A_WAM_WORD || Pl_Unify(module_word, module_word1)) && Pl_Unify(head_word, head_word1) && Pl_Unify(body_word, body_word1); } /*-------------------------------------------------------------------------* * TERM_TO_GOAL_REC * * * *-------------------------------------------------------------------------*/ static void Term_To_Goal_Rec(WamWord term_word, WamWord module_word, WamWord *goal_word) { WamWord word, tag_mask; int func, arity; WamWord *adr; WamWord *cur_H; #define FOR_ASSERT (t2g_call_info_word == NOT_A_WAM_WORD) terminal_rec: DEREF(term_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { surround_with_call: if (FOR_ASSERT) /* Term = var X --> Goal = call(X) */ { if (module_word != t2g_module_word) /* Module != entry Module --> call(Module:X) */ { *goal_word = Pl_Put_Structure(atom_call, 1); Pl_Unify_Structure(ATOM_CHAR(':'), 2); Pl_Unify_Value(module_word); Pl_Unify_Value(word); } else { *goal_word = Pl_Put_Structure(atom_call, 1); Pl_Unify_Value(word); } } else /* Term = var X --> Goal '$call_internal'(X, Module, CallInfo) */ { *goal_word = Pl_Put_Structure(atom_call_internal, 3); Pl_Unify_Value(word); Pl_Unify_Value(module_word); Pl_Unify_Value(t2g_call_info_word); } return; } if (tag_mask == TAG_ATM_MASK || tag_mask == TAG_LST_MASK) { /* Goal = Term or Module:Term */ not_a_control_construct: if (module_word == t2g_module_word) { *goal_word = word; /* Goal = Term (unchanged) */ } else if (Tag_Mask_Of(module_word) == TAG_REF_MASK) { goto surround_with_call; } else { *goal_word = Pl_Put_Structure(ATOM_CHAR(':'), 2); Pl_Unify_Value(module_word); Pl_Unify_Value(word); } return; } if (tag_mask != TAG_STC_MASK) Pl_Err_Type(pl_type_callable, t2g_term_word); adr = UnTag_STC(word); func = Functor(adr); arity = Arity(adr); if (arity != 2) goto not_a_control_construct; if (func == ATOM_CHAR(':')) /* module qualification */ { adr = &Arg(adr, 0); DEREF(*adr, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_ATM_MASK) module_word = word; else Pl_Err_Type(pl_type_atom, word); term_word = adr[1]; goto terminal_rec; } if (func != ATOM_CHAR(',') && func != ATOM_CHAR(';') && func != atom_if && func != atom_soft_if) goto not_a_control_construct; /* create a term on the heap, recursing on args for term to goal conversion */ *goal_word = Tag_STC(H); *H++ = *adr++; /* copy functor / arity (Functor_And_Arity(adr)) */ /* here we have arity words to put on the heap */ cur_H = H; H += arity; /* reserve space on the heap */ while(--arity) Term_To_Goal_Rec(*adr++, module_word, cur_H++); term_word = *adr; goal_word = cur_H; goto terminal_rec; } /*-------------------------------------------------------------------------* * PL_TERM_TO_GOAL * * * * Converts a term to a goal. Used for meta-call and for assert(a/z). * * call_info_word = NOT_A_WAM_WORD for assert else the dereferenced * * call_info of call. * *-------------------------------------------------------------------------*/ WamWord Pl_Term_To_Goal(WamWord term_word, WamWord module_word, WamWord call_info_word) { WamWord goal_word; t2g_term_word = term_word; t2g_module_word = module_word; t2g_call_info_word = call_info_word; Term_To_Goal_Rec(term_word, module_word, &goal_word); return goal_word; } /*-------------------------------------------------------------------------* * PL_TERM_TO_GOAL_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Term_To_Goal_4(WamWord term_word, WamWord module_word, WamWord call_info_word, WamWord goal_word) { WamWord goal_word1; WamWord word, tag_mask; DEREF(call_info_word, word, tag_mask); call_info_word = (tag_mask == TAG_INT_MASK) ? word : NOT_A_WAM_WORD; goal_word1 = Pl_Term_To_Goal(term_word, module_word, call_info_word); return Pl_Unify(goal_word, goal_word1); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/le_interf.wam��������������������������������������������������������������0000644�0001750�0001750�00000003063�13021356407�015762� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : le_interf.pl file_name('/home/diaz/GP/src/BipsPl/le_interf.pl'). predicate(system:'$use_le_interf'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:get_linedit_prompt/1,44,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[get_linedit_prompt,1]), call_c('Pl_Get_Linedit_Prompt_1',[boolean],[x(0)]), proceed]). predicate(system:'$get_linedit_prompt'/1,51,static,private,monofile,built_in,[ call_c('Pl_Get_Linedit_Prompt_1',[boolean],[x(0)]), proceed]). predicate(system:set_linedit_prompt/1,57,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[set_linedit_prompt,1]), call_c('Pl_Set_Linedit_Prompt_1',[],[x(0)]), proceed]). predicate(system:'$set_linedit_prompt'/1,64,static,private,monofile,built_in,[ call_c('Pl_Set_Linedit_Prompt_1',[],[x(0)]), proceed]). predicate(system:add_linedit_completion/1,70,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[add_linedit_completion,1]), call_c('Pl_Add_Linedit_Completion_1',[boolean],[x(0)]), proceed]). predicate(system:find_linedit_completion/2,77,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[find_linedit_completion,2]), call_c('Pl_Find_Linedit_Completion_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$find_linedit_completion_alt'/0,83,static,private,monofile,built_in,[ call_c('Pl_Find_Linedit_Completion_Alt_0',[boolean],[]), proceed]). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pred_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000075306�13021324543�014712� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pred_c.c * * Descr.: predicate manipulation management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdlib.h> #include <string.h> #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define CURRENT_MODULE_ALT X1_2463757272656E745F6D6F64756C655F616C74 #define CURRENT_PREDICATE_ALT X1_2463757272656E745F7072656469636174655F616C74 Prolog_Prototype(CURRENT_MODULE_ALT, 0); Prolog_Prototype(CURRENT_PREDICATE_ALT, 0); /*-------------------------------------------------------------------------* * PL_CURRENT_MODULE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Module_2(WamWord module_word, WamWord also_dollar_word) { WamWord word, tag_mask; int module; Bool also_dollar; HashScan scan; ModuleInf *mod; also_dollar = Pl_Rd_Integer(also_dollar_word); DEREF(module_word, word, tag_mask); if (tag_mask == TAG_ATM_MASK) return Pl_Lookup_Module(UnTag_ATM(word)) != NULL; if (tag_mask != TAG_REF_MASK) { #if 1 Pl_Err_Type(pl_type_atom, word); #else return false; #endif } /* non deterministic case */ #define Module_Is_Ok(module, also_dollar) \ (also_dollar || pl_atom_tbl[module].name[0] != '$') mod = (ModuleInf *) Pl_Hash_First(pl_module_tbl, &scan); for (;;) { if (mod == NULL) return FALSE; module = mod->module; if (Module_Is_Ok(module, also_dollar)) break; mod = (ModuleInf *) Pl_Hash_Next(&scan); } /* non deterministic case */ A(0) = module_word; A(1) = also_dollar; A(2) = (WamWord) scan.endt; A(3) = (WamWord) scan.cur_t; A(4) = (WamWord) scan.cur_p; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MODULE_ALT, 0), 5); return Pl_Get_Atom(module, module_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_MODULE_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Module_Alt_0(void) { WamWord module_word; int module; Bool also_dollar; HashScan scan; ModuleInf *mod; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MODULE_ALT, 0), 0); module_word = AB(B, 0); also_dollar = AB(B, 1); scan.endt = (char *) AB(B, 2); scan.cur_t = (char *) AB(B, 3); scan.cur_p = (char *) AB(B, 4); for (;;) { mod = (ModuleInf *) Pl_Hash_Next(&scan); if (mod == NULL) { Delete_Last_Choice_Point(); return FALSE; } module = mod->module; if (Module_Is_Ok(module, also_dollar)) break; } /* non deterministic case */ #if 0 /* the following data is unchanged */ AB(B, 0) = module_word; AB(B, 1) = also_dollar; AB(B, 2) = (WamWord) scan.endt; #endif AB(B, 3) = (WamWord) scan.cur_t; AB(B, 4) = (WamWord) scan.cur_p; return Pl_Get_Atom(module, module_word); } /*-------------------------------------------------------------------------* * PL_CURRENT_PREDICATE_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Predicate_4(WamWord module_word, WamWord home_module_word, WamWord pred_indic_word, WamWord also_mask_word) { WamWord name_word, arity_word; HashScan scan; ModuleInf *mod; PredInf *pred; int module, func, arity, home_module; int func1, arity1; int also_mask; /* Bool also_import; / * FIXME */ Bool also_dollar; /* 0=user, 1=user+bips, 2=user+bips+dollar */ Bool all; module = Pl_Rd_Atom(module_word); home_module = Pl_Rd_Atom(home_module_word); Pl_Get_Pred_Indicator(pred_indic_word, TRUE, &func, &arity); name_word = pl_pi_name_word; arity_word = pl_pi_arity_word; also_mask = Pl_Rd_Integer(also_mask_word); also_dollar = also_mask & 1; /* also_import = also_mask >> 1; */ #if 0 /* old code */ if (also_dollar == 0 && !Flag_Value(FLAG_STRICT_ISO)) also_dollar = 1; #endif #define Pred_Is_Ok(pred, f, a, also_dollar) \ ((also_dollar || (pl_atom_tbl[f].name[0] != '$')) && \ (pred->mod->module == home_module || \ pred == Pl_Lookup_Pred_Visible(home_module, f, a))) /* check if not hidden by parent ? */ if (func >= 0 && arity >= 0) { pred = Pl_Lookup_Pred(module, func, arity); return pred && Pred_Is_Ok(pred, func, arity, also_dollar); } /* here func or arity == -1 (or both) */ all = (func == -1 && arity == -1); #if 0 mod = Pl_Create_Module(module); /* create if not exists */ #else mod = Pl_Lookup_Module(module); if (mod == NULL) return FALSE; #endif pred = (PredInf *) Pl_Hash_First(mod->pred_tbl, &scan); for (;;) { if (pred == NULL) return FALSE; func1 = Functor_Of(pred->f_n); arity1 = Arity_Of(pred->f_n); if ((all || func == func1 || arity == arity1) && Pred_Is_Ok(pred, func1, arity1, also_dollar)) break; pred = (PredInf *) Pl_Hash_Next(&scan); } /* non deterministic case */ A(0) = name_word; A(1) = arity_word; A(2) = also_mask; A(3) = (WamWord) home_module; A(4) = (WamWord) scan.endt; A(5) = (WamWord) scan.cur_t; A(6) = (WamWord) scan.cur_p; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PREDICATE_ALT, 0), 7); return Pl_Get_Atom(Functor_Of(pred->f_n), name_word) && Pl_Get_Integer(Arity_Of(pred->f_n), arity_word); /* return Pl_Un_Atom_Check(Functor_Of(pred->f_n), name_word) && Pl_Un_Integer_Check(Arity_Of(pred->f_n), arity_word); */ } /*-------------------------------------------------------------------------* * PL_CURRENT_PREDICATE_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Predicate_Alt_0(void) { WamWord name_word, arity_word; HashScan scan; PredInf *pred; int func, arity, home_module; int func1, arity1; int also_mask; /* Bool also_import; */ Bool also_dollar; /* 0=user, 1=user+bips, 2=user+bips+dollar */ Bool all; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PREDICATE_ALT, 0), 0); name_word = AB(B, 0); arity_word = AB(B, 1); also_mask = AB(B, 2); home_module = AB(B, 3); scan.endt = (char *) AB(B, 4); scan.cur_t = (char *) AB(B, 5); scan.cur_p = (char *) AB(B, 6); also_dollar = also_mask & 1; /* also_import = also_mask >> 1; */ func = Tag_Mask_Of(name_word) == TAG_REF_MASK ? -1 : UnTag_ATM(name_word); arity = Tag_Mask_Of(arity_word) == TAG_REF_MASK ? -1 : UnTag_INT(arity_word); /* here func or arity == -1 (or both) */ all = (func == -1 && arity == -1); for (;;) { pred = (PredInf *) Pl_Hash_Next(&scan); if (pred == NULL) { Delete_Last_Choice_Point(); return FALSE; } func1 = Functor_Of(pred->f_n); arity1 = Arity_Of(pred->f_n); if ((all || func == func1 || arity == arity1) && Pred_Is_Ok(pred, func1, arity1, also_dollar)) break; } /* non deterministic case */ #if 0 /* the following data is unchanged */ AB(B, 0) = name_word; AB(B, 1) = arity_word; AB(B, 2) = also_mask; AB(B, 3) = home_module; AB(B, 4) = (WamWord) scan.endt; #endif AB(B, 5) = (WamWord) scan.cur_t; AB(B, 6) = (WamWord) scan.cur_p; return Pl_Get_Atom(Functor_Of(pred->f_n), name_word) && Pl_Get_Integer(Arity_Of(pred->f_n), arity_word); } /*-------------------------------------------------------------------------* * PL_PRED_PROP_STATIC_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Static_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_DYNAMIC) == 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_DYNAMIC_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Dynamic_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_DYNAMIC) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_PRIVATE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Private_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_PUBLIC) == 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_PUBLIC_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Public_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_PUBLIC) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_MONOFILE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Monofile_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_MULTIFILE) == 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_MULTIFILE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Multifile_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_MULTIFILE) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_USER_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_User_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_BUILTIN) == 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_BUILT_IN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Built_In_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_BUILTIN) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_BUILT_IN_FD_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Built_In_Fd_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_BUILTIN_FD) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_CONTROL_CONSTRUCT_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Control_Construct_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_CONTROL_CONSTRUCT) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_NATIVE_CODE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Native_Code_2(WamWord module_word, WamWord func_word, WamWord arity_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && (pred->prop & MASK_PRED_NATIVE_CODE) != 0; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_META_PREDICATE_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Meta_Predicate_3(WamWord module_word, WamWord func_word, WamWord arity_word, WamWord meta_pred_spec_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); MetaSpec meta_spec; WamWord word; int i, x; if (pred == NULL || !(pred->prop & MASK_PRED_META_PRED)) return FALSE; if (!Pl_Get_Structure(func, arity, meta_pred_spec_word)) return FALSE; meta_spec = pred->meta_spec; for(i = 0; i < arity; i++) { x = meta_spec & 0xf; meta_spec >>= 4; switch(x) { case META_PRED_ARG_COLON: word = Tag_ATM(ATOM_CHAR(':')); break; case META_PRED_ARG_PLUS: word = Tag_ATM(ATOM_CHAR('+')); break; case META_PRED_ARG_MINUS: word = Tag_ATM(ATOM_CHAR('-')); break; case META_PRED_ARG_QUESTION: word = Tag_ATM(ATOM_CHAR('?')); break; default: /* an integer */ word = Tag_INT(x); } if (!Pl_Unify_Value(word)) return FALSE; } return TRUE; } /*-------------------------------------------------------------------------* * PL_PRED_PROP_PROLOG_FILE_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Prolog_File_3(WamWord module_word, WamWord func_word, WamWord arity_word, WamWord pl_file_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && Pl_Un_Atom_Check(pred->pl_file, pl_file_word); } /*-------------------------------------------------------------------------* * PL_PRED_PROP_PROLOG_LINE_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Prop_Prolog_Line_3(WamWord module_word, WamWord func_word, WamWord arity_word, WamWord pl_line_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred = Pl_Lookup_Pred(module, func, arity); return pred != NULL && Pl_Un_Integer_Check(pred->pl_line, pl_line_word); } /*-------------------------------------------------------------------------* * PL_GET_PREDICATE_FILE_INFO_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Predicate_File_Info_5(WamWord module_word, WamWord func_word, WamWord arity_word, WamWord pl_file_word, WamWord pl_line_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred; if ((pred = Pl_Lookup_Pred(module, func, arity)) == NULL) return FALSE; if (pred->pl_file == pl_atom_void || pred->pl_line == 0) return FALSE; return Pl_Un_Atom_Check(pred->pl_file, pl_file_word) && Pl_Un_Integer_Check(pred->pl_line, pl_line_word); } /*-------------------------------------------------------------------------* * PL_SET_PREDICATE_FILE_INFO_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Set_Predicate_File_Info_5(WamWord module_word, WamWord func_word, WamWord arity_word, WamWord pl_file_word, WamWord pl_line_word) { int module = Pl_Rd_Atom(module_word); int func = Pl_Rd_Atom(func_word); int arity = Pl_Rd_Integer(arity_word); PredInf *pred; int pl_file, pl_line; if ((pred = Pl_Lookup_Pred(module, func, arity)) == NULL) return FALSE; pl_file = Pl_Rd_Atom_Check(pl_file_word); pl_line = Pl_Rd_Integer_Check(pl_line_word); if (pl_line < 0) return FALSE; pred->pl_file = pl_file; pred->pl_line = pl_line; return TRUE; } /*-------------------------------------------------------------------------* * PL_GET_MODULE_OF_PRED_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Module_Of_Pred_4(WamWord home_module_word, WamWord func_word, WamWord arity_word, WamWord module_word) { int home_module; int func, arity; PredInf *pred; home_module = Pl_Rd_Atom(home_module_word); func = Pl_Rd_Atom(func_word); arity = Pl_Rd_Integer(arity_word); pred = Pl_Lookup_Pred_Visible(home_module, func, arity); return pred && Pl_Get_Atom(pred->mod->module, module_word); } /*-------------------------------------------------------------------------* * PL_GET_MODULE_OF_GOAL_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Module_Of_Goal_3(WamWord home_module_word, WamWord goal_word, WamWord module_word) { int home_module; int func, arity; PredInf *pred; home_module = Pl_Rd_Atom(home_module_word); Pl_Rd_Callable_Check(goal_word, &func, &arity); pred = Pl_Lookup_Pred_Visible(home_module, func, arity); return pred && Pl_Get_Atom(pred->mod->module, module_word); } /*-------------------------------------------------------------------------* * PL_GET_MODULE_OF_GOAL_IF_NOT_META_PRED_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Get_Module_Of_Goal_If_Not_Meta_Pred_3(WamWord home_module_word, WamWord goal_word, WamWord module_word) { int home_module; int func, arity; PredInf *pred; home_module = Pl_Rd_Atom(home_module_word); Pl_Rd_Callable_Check(goal_word, &func, &arity); pred = Pl_Lookup_Pred_Visible(home_module, func, arity); return pred && !(pred->prop & MASK_PRED_META_PRED) && Pl_Get_Atom(pred->mod->module, module_word); } /*-------------------------------------------------------------------------* * PL_AUX_NAME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Aux_Name_1(WamWord name_word) { int func; func = Pl_Rd_Atom_Check(name_word); return Pl_Detect_If_Aux_Name(func) != NULL; } /*-------------------------------------------------------------------------* * PL_FATHER_OF_AUX_NAME_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Father_Of_Aux_Name_3(WamWord name_word, WamWord father_name_word, WamWord father_arity_word) { int func, father_func, father_arity; func = Pl_Rd_Atom_Check(name_word); father_func = Pl_Father_Pred_Of_Aux(func, &father_arity); if (father_func < 0) return FALSE; return Pl_Un_Atom_Check(father_func, father_name_word) && Pl_Un_Integer_Check(father_arity, father_arity_word); } /*-------------------------------------------------------------------------* * PL_PRED_WITHOUT_AUX_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Without_Aux_4(WamWord name_word, WamWord arity_word, WamWord name1_word, WamWord arity1_word) { int func, arity; int func1, arity1; func = Pl_Rd_Atom_Check(name_word); arity = Pl_Rd_Integer_Check(arity_word); func1 = Pl_Pred_Without_Aux(func, arity, &arity1); return Pl_Un_Atom_Check(func1, name1_word) && Pl_Un_Integer_Check(arity1, arity1_word); } /*-------------------------------------------------------------------------* * PL_MAKE_AUX_NAME_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Make_Aux_Name_4(WamWord name_word, WamWord arity_word, WamWord aux_nb_word, WamWord aux_name_word) { int func, arity; int aux_nb; int aux_name; func = Pl_Rd_Atom_Check(name_word); arity = Pl_Rd_Integer_Check(arity_word); aux_nb = Pl_Rd_Integer_Check(aux_nb_word); aux_name = Pl_Make_Aux_Name(func, arity, aux_nb); return Pl_Un_Atom_Check(aux_name, aux_name_word); } /*-------------------------------------------------------------------------* * PL_DECL_META_PRED_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Decl_Meta_Pred_2(WamWord module_word, WamWord meta_pred_spec_word) { int module; int func, arity; WamWord *arg_adr; PredInf *pred; WamWord word, tag_mask; int i, x; int atom; MetaSpec meta_spec = 0; module = Pl_Rd_Atom_Check(module_word); arg_adr = Pl_Rd_Compound_Check(meta_pred_spec_word, &func, &arity); if (arity > 16) /* 4-bits/arg on 64 bits = 16 agrs max */ return FALSE; /* FIXME: emit a representation error max_arity_meta_predicate */ pred = Pl_Lookup_Pred_Visible(module, func, arity); if (pred == NULL) return FALSE; for (i = 0; i < arity; i++, arg_adr++) { DEREF(*arg_adr, word, tag_mask); if (tag_mask == TAG_REF_MASK) /* should not occur */ Pl_Err_Instantiation(); if (tag_mask == TAG_INT_MASK) { x = UnTag_INT(word); if (x >= 0 && x < META_PRED_ARG_COLON) { ok: meta_spec |= x << (i * 4); continue; } } if (tag_mask == TAG_ATM_MASK) { x = -1; atom = UnTag_ATM(word); if (atom == ATOM_CHAR(':')) x = META_PRED_ARG_COLON; else if (atom == ATOM_CHAR('+')) x = META_PRED_ARG_PLUS; else if (atom == ATOM_CHAR('-')) x = META_PRED_ARG_MINUS; else if (atom == ATOM_CHAR('?') || atom == ATOM_CHAR('*')) x = META_PRED_ARG_QUESTION; if (x >= 0) goto ok; } #if 0 /* FIXME: should be a domain error meta_argument_specifier */ Pl_Err_Domain(blabla, word); #endif } pred->prop |= MASK_PRED_META_PRED; pred->meta_spec = meta_spec; return TRUE; } /*-------------------------------------------------------------------------* * PL_STRIP_MODULE_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Strip_Module_3(WamWord term_word, WamWord module_word, WamWord plain_word) { WamWord goal_word, module_word1; module_word1 = Pl_Strip_Module(term_word, FALSE, FALSE, &goal_word); #if 1 /* should not occur since meta_predicate declaration */ if (module_word1 == NOT_A_WAM_WORD) module_word1 = Tag_ATM(pl_atom_user); #endif return Pl_Unify(module_word1, module_word) && Pl_Unify(goal_word, plain_word); } /*-------------------------------------------------------------------------* * PL_STRIP_MODULE_VAR_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Strip_Module_Var_3(WamWord term_word, WamWord module_word, WamWord plain_word) { WamWord goal_word, module_word1; Pl_Unset_Calling_Module(); module_word1 = Pl_Strip_Module(term_word, TRUE, TRUE, &goal_word); /* here there is no meta_predicate declaration */ if (module_word1 == NOT_A_WAM_WORD) Pl_Set_Calling_Module(pl_atom_user); else if (!Pl_Unify(module_word1, module_word)) return FALSE; return Pl_Unify(goal_word, plain_word); } /*-------------------------------------------------------------------------* * PL_STRIP_MODULE_NONVAR_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Strip_Module_Nonvar_3(WamWord term_word, WamWord module_word, WamWord plain_word) { WamWord goal_word, module_word1; Pl_Unset_Calling_Module(); module_word1 = Pl_Strip_Module(term_word, FALSE, TRUE, &goal_word); /* here there is no meta_predicate declaration */ if (module_word1 == NOT_A_WAM_WORD) Pl_Set_Calling_Module(pl_atom_user); else if (!Pl_Unify(module_word1, module_word)) return FALSE; return Pl_Unify(goal_word, plain_word); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/consult.pl�����������������������������������������������������������������0000644�0001750�0001750�00000026450�13021324543�015332� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : consult.pl * * Descr.: file consulting * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_consult'. /* the meta_predicate declaration is to allow foo:consult(File) * foo becomes the destination module. If File does not contain any module definition * (i.e. module = user) then the consult is done in the destination module (foo) instead of user. */ :- meta_predicate(consult(:)). :- meta_predicate('.'(:, +)). [File|Files] :- consult([File|Files]). consult(MFile) :- set_bip_name(consult, 1), '$strip_module_nonvar'(MFile, Module, File), % the destination module %format('Consulting File: ~w in module: ~w~n', [File, Module]), '$check_atom_or_atom_list'(File), !, ( atom(File), File \== [] -> '$consult2'(File, Module) ; '$consult1'(File, Module) ). '$consult1'([], _). '$consult1'([File|Files], Module) :- '$consult2'(File, Module), '$consult1'(Files, Module). '$consult2'(MFile, Module0) :- '$strip_module_nonvar'(MFile, Module1, File), % individual destination module ( var(Module1) -> % not given, use inherited destination module Module = Module0 ; Module = Module1 % given: use this ), '$call_c_test'('Pl_Prolog_File_Name_2'(File, File1)), ( File1 = user -> File2 = File1 ; '$call_c_test'('Pl_Absolute_File_Name_2'(File1, File2)), ( file_exists(File2) -> true ; set_bip_name(consult, 1), '$pl_err_existence'(source_sink, File1) ) ), temporary_file('', gplc, TmpFile), set_bip_name(consult, 1), ( '$consult3'(TmpFile, File2) -> '$load_file'(TmpFile, Module), unlink(TmpFile) ; unlink(TmpFile), format(top_level_output, 'compilation failed~n', []), fail ). '$consult3'(TmpFile, PlFile) :- '$call_c_test'('Pl_Consult_2'(TmpFile, PlFile)). /* '$consult3'(TmpFile,PlFile):- write_pl_state_file(TmpFile), Args=['-w','--compile-msg','--pl-state',TmpFile,'-o',TmpFile,PlFile|End], (current_prolog_flag(singleton_warning,on) -> End=[] ; End=['--no-singl-warn']), spawn(pl2wam,Args,0). */ '$load_file'(BCFile, Module) :- % Module is the destination Module open(BCFile, read, Stream), repeat, read(Stream, P), ( P = end_of_file -> ! ; '$load_pred'(P, Stream, Module), fail ), close(Stream). /* DEBUG '$load_pred'(P, _Stream, Module) :- format('LOAD: ~w MOD:~w~n', [P, Module]), fail. */ '$load_pred'(file_name(PlFile), _, _) :- g_assign('$pl_file', PlFile). '$load_pred'(directive(PlLine, Type, Goal), _, Module) :- ( '$catch'(Goal, CallErr, '$load_directive_exception'(CallErr, PlLine, Type), Module, load, 1) -> true ; g_read('$pl_file', PlFile), format(top_level_output, '~Nwarning: ~a:~d: ~a directive failed~n', [PlFile, PlLine, Type]) ). '$load_pred'(predicate(PI, PlLine, StaDyn, PubPriv, MonoMulti, UsBplBfd, NbCl), Stream, Module0) :- '$load_pred_extract_module'(PI, Module0, Pred, N, Module), !, g_read('$pl_file', PlFile), '$check_pred_type'(Module, Pred, N, PlFile, PlLine), % DEBUG format('LOAD: pred ~w:~w/~w from:~w:~w~n', [Module, Pred, N, PlFile, PlLine]), ( MonoMulti = (multifile), '$predicate_property1'(Module, Pred, N, multifile) -> true ; '$check_owner_files'(Module, Pred, N, PlFile, PlLine) ), '$bc_start_pred'(Module, Pred, N, PlFile, PlLine, StaDyn, PubPriv, MonoMulti, UsBplBfd), g_assign('$ctr', 0), repeat, g_read('$ctr', Ctr), Ctr1 is Ctr + 1, g_assign('$ctr', Ctr1), ( Ctr = NbCl -> true ; read(Stream, clause(Cl, WamCl)), '$add_clause_term_and_bc'(Module, Cl, PlFile, WamCl), fail ), !. % if user, select the destination Module '$load_pred_extract_module'(user:Pred/N, Module, Pred, N, Module). % if pred module != user use it '$load_pred_extract_module'(Module:Pred/N, _, Pred, N, Module). % if no module specified use destination Module (should not occur) '$load_pred_extract_module'(Pred/N, Module, Pred, N, Module). '$load_directive_exception'(CallErr, PlLine, Type) :- g_read('$pl_file', PlFile), format(top_level_output, '~Nwarning: ~a:~d: ~a directive caused exception: ~q~n', [PlFile, PlLine, Type, CallErr]). '$check_pred_type'(Module, Pred, N, PlFile, PlLine) :- '$predicate_property1'(Module, Pred, N, native_code), !, ( '$aux_name'(Pred) -> true ; format(top_level_output, 'error: ~a:~d: native code procedure ~q cannot be redefined (ignored)~n', [PlFile, PlLine, Pred/N]) ), fail. '$check_pred_type'(_, _, _, _, _). '$check_owner_files'(Module, F, N, PlFile, PlLine) :- '$get_predicate_file_info'(Module, F, N, PlFile1, PlLine1), PlFile \== PlFile1, !, ( '$aux_name'(F) -> true ; format(top_level_output, 'warning: ~a:~d: redefining procedure ~q~n', [PlFile, PlLine, F/N]), format(top_level_output, ' ~a:~d: previous definition~n', [PlFile1, PlLine1]) ). '$check_owner_files'(_, _, _, _, _). :- meta_predicate(load(:)). load(MFile) :- set_bip_name(load, 1), '$strip_module_nonvar'(MFile, Module, File), % the destination module '$check_atom_or_atom_list'(File), !, ( atom(File), File \== [] -> '$load2'(File, Module) ; '$load1'(File, Module) ). '$load1'([], _). '$load1'([File|Files], Module) :- '$load2'(File, Module), '$load1'(Files, Module). '$load2'(MFile, Module0) :- '$strip_module_nonvar'(MFile, Module1, File), % individual destination module ( var(Module1) -> % not given, use inherited destination module Module = Module0 ; Module = Module1 % given: use this ), decompose_file_name(File, _Dir, _Prefix, Suffix), ( Suffix = '' -> atom_concat(File, '.wbc', File1) ; File1 = File ), '$call_c_test'('Pl_Absolute_File_Name_2'(File1, File2)), ( file_exists(File2) -> true ; set_bip_name(load, 1), '$pl_err_existence'(source_sink, File1) ), set_bip_name(load, 1), '$load_file'(File1, Module). '$bc_start_pred'(Module, Pred, N, PlFile, PlLine, StaDyn, PubPriv, MonoMulti, UsBplBfd) :- '$call_c'('Pl_BC_Start_Pred_9'(Module, Pred, N, PlFile, PlLine, StaDyn, PubPriv, MonoMulti, UsBplBfd)). '$bc_start_emit' :- '$call_c'('Pl_BC_Start_Emit_0'). '$bc_stop_emit' :- '$call_c'('Pl_BC_Stop_Emit_0'). '$bc_emit'([]). '$bc_emit'([WamInst|WamCode]) :- '$bc_emit_inst'(WamInst), '$bc_emit'(WamCode). '$bc_emit_inst'(WamInst) :- '$call_c'('Pl_BC_Emit_Inst_1'(WamInst)). '$bc_emulate_cont' :- % used by C code to set a continuation '$call_c_jump'('Pl_BC_Emulate_Cont_0'). % called by compiled code for dynamic or multifile predicate '$add_clause_term'(Module, Cl, PlFile) :- '$assert'(Module:Cl, 0, 0, PlFile). % called by '$load_pred' '$add_clause_term_and_bc'(Module, Cl, PlFile, WamCl) :- '$bc_start_emit', '$bc_emit'(WamCl), '$bc_stop_emit', '$add_clause_term'(Module, Cl, PlFile). % Listing :- meta_predicate(listing(:)). listing :- set_bip_name(listing, 0), '$listing_all'(user, _, _). %FIXME what to do with a meta_pred without argument ? listing(MPI) :- set_bip_name(listing, 1), '$strip_module_var'(MPI, Module, PI), ( atom(PI) -> Func = PI ; '$get_pred_indic_var'(PI, Module, _, Func, Arity) ), '$listing_all'(Module, Func, Arity). /* NEW version which orders the output by file then by line number */ '$listing_all'(Module, Func, Arity) :- % setof: for each File returns a sorted list [Line-PI,...] g_assign('$last_module', Module), setof(v(Line, Func, Arity), '$listing_one_collect'(Module, Func, Arity, File, Line), LP), g_read('$last_module', LastModule), ( LastModule == Module -> true ; format('~n:- module(~q).~n', [Module]), g_assign('$last_module', Module) ), format('~n%% file: ~w~n', [File]), member(v(_, Func1, Arity1), LP), '$listing_one_show'(Module, Func1, Arity1). % this one fails '$listing_all'(_, _, _). '$listing_one_collect'(Module, Func, Arity, File, Line) :- '$current_predicate'(Module:Func/Arity), ( '$call_c_test'('Pl_Pred_Prop_Native_Code_2'(Module, Func, Arity)) -> fail ; '$call_c_test'('Pl_Pred_Prop_Prolog_File_3'(Module, Func, Arity, File)), '$call_c_test'('Pl_Pred_Prop_Prolog_Line_3'(Module, Func, Arity, Line)) ). /* OLD version which does not order the output '$listing_all'(Module, Func, Arity) :- g_assign('$last_module', Module), '$current_predicate'(Module:Func/Arity), ( '$call_c_test'('Pl_Pred_Prop_Native_Code_2'(Module, Func, Arity)) -> fail ; true ), g_read('$last_module', LastModule), ( LastModule == Module -> true ; format(':- module(~q).~n', [Module]), g_assign('$last_module', Module) ), '$listing_one_show'(Module, Func, Arity). % this one fails */ '$listing_one_show'(Module, Func, Arity) :- functor(H, Func, Arity), nl, '$clause'(Module:H, B, false), portray_clause((H :- B)), fail. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/list_c.c�������������������������������������������������������������������0000644�0001750�0001750�00000041120�13021324543�014716� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : list_c.c * * Descr.: list library - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define APPEND_ALT X1_24617070656E645F616C74 #define LENGTH_ALT X1_246C656E6774685F616C74 #define MEMBER_ALT X1_246D656D6265725F616C74 #define REVERSE_ALT X1_24726576657273655F616C74 Prolog_Prototype(APPEND_ALT, 0); Prolog_Prototype(LENGTH_ALT, 0); Prolog_Prototype(MEMBER_ALT, 0); Prolog_Prototype(REVERSE_ALT, 0); #if 1 /*-------------------------------------------------------------------------* * Pl_APPEND_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Append_3(WamWord l1_word, WamWord l2_word, WamWord l3_word) { WamWord word, tag_mask; WamWord *adr; int len1, len2, len3; WamWord result_word; WamWord *next_H; for(;;) { DEREF(l1_word, word, tag_mask); if (tag_mask != TAG_LST_MASK) break; adr = UnTag_LST(word); DEREF(l3_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) /* as soon as L3 is a var, create the result and unify with L3 at the end only */ { result_word = Tag_LST(H); do { next_H = H + 2; *H++ = Car(adr); *H++ = Tag_LST(next_H); l1_word = Cdr(adr); DEREF(l1_word, word, tag_mask); adr = UnTag_LST(word); } while(tag_mask == TAG_LST_MASK); next_H = H - 1; *next_H = Make_Self_Ref(next_H); Pl_Unify(result_word, l3_word); l3_word = *next_H; break; } /* here L3 is not a var */ if (!Pl_Get_List(l3_word) || !Pl_Unify_Value(Car(adr))) return FALSE; l3_word = Pl_Unify_Variable(); l1_word = Cdr(adr); } if (word == NIL_WORD) return Pl_Unify(l2_word, l3_word); if (tag_mask != TAG_REF_MASK) return FALSE; /* L1 is a var, let's see L2 and L3 */ if ((len2 = Pl_List_Length(l2_word)) >= 0 && (len3 = Pl_List_Length(l3_word)) >= 0) { /* deterministic: L1 is the prefix of L3 with len = len3 - len2 */ if ((len1 = len3 - len2) < 0) return FALSE; while(len1-- > 0) { DEREF(l3_word, word, tag_mask); adr = UnTag_LST(word); Pl_Get_List(l1_word); Pl_Unify_Value(Car(adr)); l1_word = Pl_Unify_Variable(); l3_word = Cdr(adr); } Pl_Get_Nil(l1_word); /* always succeeds */ return Pl_Unify(l2_word, l3_word); } /* L1 is a var, L2 / L3 are not 2 proper lists, check L3 */ DEREF(l3_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_LST_MASK) /* nondet case */ { A(0) = l1_word; A(1) = l2_word; A(2) = l3_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(APPEND_ALT, 0), 3); } Pl_Get_Nil(l1_word); /* always succeeds */ return Pl_Unify(l2_word, l3_word); } #else /* less efficient version */ /*-------------------------------------------------------------------------* * Pl_APPEND_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Append_3(WamWord l1_word, WamWord l2_word, WamWord l3_word) { WamWord word, tag_mask; WamWord *adr; int len1, len2, len3; for(;;) { DEREF(l1_word, word, tag_mask); if (tag_mask != TAG_LST_MASK) break; adr = UnTag_LST(word); if (!Pl_Get_List(l3_word) || !Pl_Unify_Value(Car(adr))) return FALSE; l3_word = Pl_Unify_Variable(); l1_word = Cdr(adr); } if (word == NIL_WORD) return Pl_Unify(l2_word, l3_word); if (tag_mask != TAG_REF_MASK) return FALSE; /* L1 is a var, let's see L2 and L3 */ if ((len2 = Pl_List_Length(l2_word)) >= 0 && (len3 = Pl_List_Length(l3_word)) >= 0) { /* deterministic: L1 is the prefix of L3 with len = len3 - len2 */ if ((len1 = len3 - len2) < 0) return FALSE; while(len1-- > 0) { DEREF(l3_word, word, tag_mask); adr = UnTag_LST(word); Pl_Get_List(l1_word); Pl_Unify_Value(Car(adr)); l1_word = Pl_Unify_Variable(); l3_word = Cdr(adr); } Pl_Get_Nil(l1_word); /* always succeeds */ return Pl_Unify(l2_word, l3_word); } /* L1 is a var, L2 / L3 are not 2 proper lists, check L3 */ DEREF(l3_word, word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_LST_MASK) /* nondet case */ { A(0) = l1_word; A(1) = l2_word; A(2) = l3_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(APPEND_ALT, 0), 3); } Pl_Get_Nil(l1_word); return Pl_Unify(l2_word, l3_word); } #endif /*-------------------------------------------------------------------------* * PL_APPEND_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Append_Alt_0(void) { WamWord x_word; WamWord word, tag_mask; /* here L1 is a var - L3 is a var or [_|_] */ Pl_Delete_Choice_Point(3); Pl_Get_List(A(2)); x_word = Pl_Unify_Variable(); A(2) = Pl_Unify_Variable(); Pl_Get_List(A(0)); Pl_Unify_Value(x_word); /* cannot fail since L1 is a var */ A(0) = Pl_Unify_Variable(); DEREF(A(2), word, tag_mask); if (tag_mask == TAG_REF_MASK || tag_mask == TAG_LST_MASK) /* nondet case */ Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(APPEND_ALT, 0), 3); Pl_Get_Nil(A(0)); return Pl_Unify(A(1), A(2)); } /*-------------------------------------------------------------------------* * Pl_MEMBER_2 * * * * To optimize, we don't pass arguments, we know they are in A(0) and A(1) * *-------------------------------------------------------------------------*/ static Bool Pl_Member_3(void); Bool Pl_Member_2(void) { if (!Pl_Get_List(A(1))) return FALSE; A(1) = Pl_Unify_Variable(); A(2) = Pl_Unify_Variable(); return Pl_Member_3(); } static Bool Pl_Member_3(void) { WamWord word, tag_mask; Bool ok; for(;;) { Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(MEMBER_ALT, 0), 3); ok = Pl_Unify(A(0), A(1)); DEREF(A(2), word, tag_mask); #if 1 if (tag_mask != TAG_REF_MASK && tag_mask != TAG_LST_MASK) { Assign_B(BB(B)); /* cut (if failure faster then Pl_Delete_Choice_Point() */ return ok; } #endif if (ok) { AB(B, 2) = word; return ok; } Pl_Delete_Choice_Point(3); #if 0 if (!Pl_Get_List(A(2))) return FALSE; #else Pl_Get_List(A(2)); /* always succeeds */ #endif A(1) = Pl_Unify_Variable(); A(2) = Pl_Unify_Variable(); } } /*-------------------------------------------------------------------------* * PL_MEMBER_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Member_Alt_0(void) { Pl_Delete_Choice_Point(3); #if 0 if (!Pl_Get_List(A(2))) return FALSE; #else Pl_Get_List(A(2)); /* always succeeds */ #endif A(1) = Pl_Unify_Variable(); A(2) = Pl_Unify_Variable(); return Pl_Member_3(); } /*-------------------------------------------------------------------------* * Pl_MEMBERCHK_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Memberchk_2(WamWord elem_word, WamWord list_word) { Bool ret; Pl_Defeasible_Open(); for(;;) { if (!Pl_Get_List(list_word)) { ret = FALSE; break; } if (Pl_Unify_Value(elem_word)) /* unification will trail */ { Pl_Unify_Void(1); /* important if in write mode (list_word is a var) */ ret = TRUE; break; } Pl_Defeasible_Undo(); /* undo bindings after unif failure (e.g. f(X,b,c) = f(a,Y,d)) */ list_word = Pl_Unify_Variable(); } Pl_Defeasible_Close(ret); return ret; } /*-------------------------------------------------------------------------* * Pl_LENGTH_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Length_2(WamWord list_word, WamWord n_word) { WamWord word, tag_mask; WamWord *adr; PlLong n, len = 0; DEREF(n_word, word, tag_mask); n_word = word; if (tag_mask == TAG_INT_MASK) { n = UnTag_INT(word); if (n < 0) { #if 1 Pl_Err_Domain(pl_domain_not_less_than_zero, word); #else return FALSE; #endif } } else { if (tag_mask != TAG_REF_MASK) Pl_Err_Type(pl_type_integer, word); n = -1; } for(;;) { DEREF(list_word, word, tag_mask); if (word == NIL_WORD) return (n == len) || Pl_Get_Integer(len, n_word); if (tag_mask == TAG_REF_MASK) { if (n < 0) /* non-deterministic case */ break; if (n == len) return Pl_Get_Nil(word); /* return is TRUE */ Pl_Get_List(word); Pl_Unify_Void(1); list_word = Pl_Unify_Variable(); len++; continue; } if (tag_mask != TAG_LST_MASK) return FALSE; len++; if ((PlULong) n < (PlULong) len) return FALSE; adr = UnTag_LST(word); list_word = Cdr(adr); } /* non-deterministic case */ A(0) = list_word; A(1) = n_word; A(2) = Tag_INT(len); Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(LENGTH_ALT, 0), 3); Pl_Get_Nil(list_word); return Pl_Get_Integer(len, n_word); /* always TRUE */ } /*-------------------------------------------------------------------------* * PL_LENGTH_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Length_Alt_0(void) { WamWord list_word, n_word; int len; Pl_Delete_Choice_Point(3); list_word = A(0); n_word = A(1); len = UnTag_INT(A(2)) + 1; Pl_Get_List(list_word); /* always succeed */ Pl_Unify_Void(1); list_word = Pl_Unify_Variable(); A(0) = list_word; /* A(1) = n_word; */ A(2) = Tag_INT(len); Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(LENGTH_ALT, 0), 3); Pl_Get_Nil(list_word); return Pl_Get_Integer(len, n_word); /* always TRUE */ } /*-------------------------------------------------------------------------* * PL_NTH0_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Nth0_3(WamWord n_word, WamWord list_word, WamWord res_word, int base) { WamWord elem_word; PlLong n = Pl_Rd_Integer(n_word) - base; if (n < 0) return FALSE; for(;;) { if (!Pl_Get_List(list_word)) return FALSE; elem_word = Pl_Unify_Variable(); list_word = Pl_Unify_Variable(); if (n == 0) return Pl_Unify(elem_word, res_word); n--; } } /*-------------------------------------------------------------------------* * PL_REVERSE_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Reverse_2(WamWord l1_word, WamWord l2_word) { WamWord word, tag_mask; WamWord *adr; int len1 = 0, len2; WamWord x_word; WamWord result_word = NIL_WORD; for(;;) { DEREF(l1_word, word, tag_mask); if (tag_mask != TAG_LST_MASK) break; adr = UnTag_LST(word); word = Tag_LST(H); *H++ = Car(adr); *H++ = result_word; result_word = word; len1++; l1_word = Cdr(adr); } if (word == NIL_WORD) return Pl_Unify(result_word, l2_word); if (tag_mask != TAG_REF_MASK) return FALSE; /* L1 ends with a variable */ len2 = Pl_List_Length(l2_word); if (len2 >= 0) { if (len2 < len1) return FALSE; while(len1 < len2) /* L1 and Result must have len2 elements */ { Pl_Get_List(l1_word); x_word = Pl_Unify_Variable(); l1_word = Pl_Unify_Variable(); word = Tag_LST(H); *H++ = x_word; *H++ = result_word; result_word = word; len1++; } } else { A(0) = l1_word; /* non-deterministic case: both end with a variable - infinite nb of sols */ A(1) = l2_word; A(2) = result_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(REVERSE_ALT, 0), 3); } Pl_Get_Nil(l1_word); return Pl_Unify(result_word, l2_word); } /*-------------------------------------------------------------------------* * PL_REVERSE_ALT_0 * * * *-------------------------------------------------------------------------*/ Bool Pl_Reverse_Alt_0(void) { WamWord x_word, result_word; Pl_Delete_Choice_Point(3); /* create a new sol: add X at the of L1 and X at the beginning of Result */ /* (which is unified with L2) */ Pl_Get_List(A(0)); x_word = Pl_Unify_Variable(); A(0) = Pl_Unify_Variable(); result_word = Tag_LST(H); *H++ = x_word; *H++ = A(2); A(2) = result_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(REVERSE_ALT, 0), 3); Pl_Get_Nil(A(0)); return Pl_Unify(result_word, A(1)); } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/control_c.c����������������������������������������������������������������0000644�0001750�0001750�00000014226�13021324543�015432� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : control_c.c * * Descr.: control management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ #define BETWEEN_ALT X1_246265747765656E5F616C74 Prolog_Prototype(BETWEEN_ALT, 0); /*-------------------------------------------------------------------------* * PL_HALT_IF_NO_TOP_LEVEL_1 * * * *-------------------------------------------------------------------------*/ WamCont Pl_Halt_If_No_Top_Level_1(WamWord exit_code_word) { PredInf *pred; int x; x = Pl_Rd_Integer_Check(exit_code_word); if (SYS_VAR_TOP_LEVEL == 0) /* no top level running */ Pl_Exit_With_Value(x); pred = Pl_Check_Sys_Pred_Exist((x) ? "$top_level_abort" : "$top_level_stop", 0); if (pred == NULL) /* should not occur */ Pl_Exit_With_Value(x); return (WamCont) (pred->codep); } /*-------------------------------------------------------------------------* * PL_HALT_1 * * * *-------------------------------------------------------------------------*/ void Pl_Halt_1(WamWord exit_code_word) { Pl_Exit_With_Value(Pl_Rd_Integer_Check(exit_code_word)); } /*-------------------------------------------------------------------------* * PL_BETWEEN_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Between_3(WamWord l_word, WamWord u_word, WamWord i_word) { WamWord word, tag_mask; PlLong l, u, i; l = Pl_Rd_Integer_Check(l_word); u = Pl_Rd_Integer_Check(u_word); DEREF(i_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) { i = Pl_Rd_Integer_Check(word); return i >= l && i <= u; } i_word = word; if (l > u) return FALSE; /* here i_word is a variable */ if (l < u) /* non deterministic case */ { A(0) = l + 1; A(1) = u; A(2) = i_word; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(BETWEEN_ALT, 0), 3); } return Pl_Get_Integer(l, i_word); /* always TRUE */ } /*-------------------------------------------------------------------------* * PL_BETWEEN_ALT_0 * * * *-------------------------------------------------------------------------*/ void Pl_Between_Alt_0(void) { PlLong l, u; WamWord i_word; Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(BETWEEN_ALT, 0), 0); l = AB(B, 0); u = AB(B, 1); i_word = AB(B, 2); /* here i_word is a variable */ if (l == u) Delete_Last_Choice_Point(); else /* non deterministic case */ { AB(B, 0) = l + 1; #if 0 /* the following data is unchanged */ AB(B, 1) = u; AB(B, 2) = i_word; #endif } Pl_Get_Integer(l, i_word); /* always TRUE */ } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/control.wam����������������������������������������������������������������0000644�0001750�0001750�00000002701�13021356407�015471� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : control.pl file_name('/home/diaz/GP/src/BipsPl/control.pl'). predicate(system:'$use_control'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:repeat/0,46,static,private,monofile,built_in,[ try_me_else(1), proceed, label(1), trust_me_else_fail, execute(repeat/0)]). predicate(system:abort/0,54,static,private,monofile,built_in,[ put_integer(1,0), call_c('Pl_Halt_If_No_Top_Level_1',[jump],[x(0)]), proceed]). predicate(system:stop/0,58,static,private,monofile,built_in,[ put_integer(0,0), call_c('Pl_Halt_If_No_Top_Level_1',[jump],[x(0)]), proceed]). predicate(system:halt/0,65,static,private,monofile,built_in,[ put_integer(0,0), execute(halt/1)]). predicate(system:halt/1,71,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[halt,1]), call_c('Pl_Halt_1',[],[x(0)]), proceed]). predicate(system:between/3,79,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[between,3]), call_c('Pl_Between_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$between_alt'/0,83,static,private,monofile,built_in,[ call_c('Pl_Between_Alt_0',[],[]), proceed]). predicate(system:for/3,88,static,private,monofile,built_in,[ call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[for,3]), call_c('Pl_Between_3',[boolean],[x(1),x(2),x(0)]), proceed]). ���������������������������������������������������������������gprolog-1.4.5/src/BipsPl/pretty_c.c�����������������������������������������������������������������0000644�0001750�0001750�00000050125�13021324543�015277� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : pretty_c.c * * Descr.: pretty print clause management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #define OBJ_INIT Pretty_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ #define GENERAL_BODY 0 #define LEFT_AND 1 #define RIGHT_AND 2 #define LEFT_OR 3 #define RIGHT_OR 4 #define LEFT_IF 5 #define RIGHT_IF 6 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ static int atom_clause; static int atom_dcg; static int atom_if; static int atom_soft_if; /* soft-cut */ static int atom_dollar_var; static int atom_dollar_varname; static WamWord dollar_var_1; static WamWord dollar_varname_1; static WamWord equal_2; static PlLong *singl_var_ptr; static int nb_singl_var; static int nb_to_try; static WamWord *above_H; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static void Portray_Clause(StmInf *pstm, WamWord term_word); static Bool Check_Structure(WamWord term_word, int func, int arity, WamWord arg_word[]); static Bool Is_Cut(WamWord body_word); static void Show_Body(StmInf *pstm, int level, int context, WamWord body_word); static void Start_Line(StmInf *pstm, int level, char c_before); static Bool Collect_Singleton(WamWord *adr); static int Var_Name_To_Var_Number(int atom); static void Exclude_A_Var_Number(int n); static void Collect_Excluded_Rec(WamWord start_word); static Bool Bind_Variable(WamWord *adr, WamWord word); /*-------------------------------------------------------------------------* * PRETTY_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Pretty_Initializer(void) { atom_clause = Pl_Create_Atom(":-"); atom_dcg = Pl_Create_Atom("-->"); atom_if = Pl_Create_Atom("->"); atom_soft_if = Pl_Create_Atom("*->"); atom_dollar_var = Pl_Create_Atom("$VAR"); atom_dollar_varname = Pl_Create_Atom("$VARNAME"); dollar_var_1 = Functor_Arity(atom_dollar_var, 1); dollar_varname_1 = Functor_Arity(atom_dollar_varname, 1); equal_2 = Functor_Arity(ATOM_CHAR('='), 2); } /*-------------------------------------------------------------------------* * PL_PORTRAY_CLAUSE_3 * * * *-------------------------------------------------------------------------*/ void Pl_Portray_Clause_3(WamWord sora_word, WamWord term_word, WamWord above_word) { int stm; StmInf *pstm; WamWord *b; stm = (sora_word == NOT_A_WAM_WORD) ? pl_stm_output : Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_OUTPUT); pstm = pl_stm_tbl[stm]; pl_last_output_sora = sora_word; Pl_Check_Stream_Type(stm, TRUE, FALSE); b = LSSA + Pl_Rd_Integer(above_word); /* see Pl_Get_Current_Choice / Pl_Cut */ above_H = HB(b); Portray_Clause(pstm, term_word); } /*-------------------------------------------------------------------------* * PL_PORTRAY_CLAUSE_2 * * * *-------------------------------------------------------------------------*/ void Pl_Portray_Clause_2(WamWord term_word, WamWord above_word) { Pl_Portray_Clause_3(NOT_A_WAM_WORD, term_word, above_word); } #define WRITE_MASK (WRITE_NUMBER_VARS | WRITE_NAME_VARS | \ WRITE_QUOTED | WRITE_SPACE_ARGS) /*-------------------------------------------------------------------------* * PORTRAY_CLAUSE * * * *-------------------------------------------------------------------------*/ static void Portray_Clause(StmInf *pstm, WamWord term_word) { WamWord word, tag_mask; WamWord arg_word[2]; int atom; if (Check_Structure(term_word, atom_clause, 2, arg_word)) { Pl_Write_Term(pstm, -1, 1200 - 1, WRITE_MASK, above_H, arg_word[0]); DEREF(arg_word[1], word, tag_mask); atom = UnTag_ATM(word); if (tag_mask != TAG_ATM_MASK || atom != pl_atom_true) { Pl_Stream_Puts(" :-", pstm); Start_Line(pstm, 0, ' '); Show_Body(pstm, 0, GENERAL_BODY, arg_word[1]); } Pl_Write_A_Full_Stop(pstm); return; } if (Check_Structure(term_word, atom_dcg, 2, arg_word)) { Pl_Write_Term(pstm, -1, 1200 - 1, WRITE_MASK, above_H, arg_word[0]); DEREF(arg_word[1], word, tag_mask); atom = UnTag_ATM(word); if (tag_mask != TAG_ATM_MASK || atom != pl_atom_true) { Pl_Stream_Puts(" -->", pstm); Start_Line(pstm, 0, ' '); Show_Body(pstm, 0, GENERAL_BODY, arg_word[1]); } Pl_Write_A_Full_Stop(pstm); return; } if (Check_Structure(term_word, atom_clause, 1, arg_word)) { Pl_Stream_Puts(":-\t", pstm); Show_Body(pstm, 0, GENERAL_BODY, arg_word[0]); Pl_Write_A_Full_Stop(pstm); return; } Pl_Write_Term(pstm, -1, MAX_PREC, WRITE_MASK, above_H, term_word); Pl_Write_A_Full_Stop(pstm); } /*-------------------------------------------------------------------------* * CHECK_STRUCTURE * * * *-------------------------------------------------------------------------*/ static Bool Check_Structure(WamWord term_word, int func, int arity, WamWord arg_word[]) { WamWord word, tag_mask; WamWord *adr; int i; DEREF(term_word, word, tag_mask); if (tag_mask != TAG_STC_MASK) return FALSE; adr = UnTag_STC(word); if (Functor_And_Arity(adr) != Functor_Arity(func, arity)) return FALSE; for (i = 0; i < arity; i++) arg_word[i] = Arg(adr, i); return TRUE; } /*-------------------------------------------------------------------------* * IS_CUT * * * *-------------------------------------------------------------------------*/ static Bool Is_Cut(WamWord body_word) { WamWord word, tag_mask; WamWord arg_word[2]; while (Check_Structure(body_word, ATOM_CHAR(','), 2, arg_word)) body_word = arg_word[0]; DEREF(body_word, word, tag_mask); return (word == Tag_ATM(ATOM_CHAR('!'))); } /*-------------------------------------------------------------------------* * SHOW_BODY * * * *-------------------------------------------------------------------------*/ static void Show_Body(StmInf *pstm, int level, int context, WamWord body_word) { WamWord arg_word[2]; int soft_cut; static int prec[] = { 1200 - 1, 1000 - 1, 1000, 1100 - 1, 1100, 1050 - 1, 1050 }; if (Check_Structure(body_word, ATOM_CHAR(','), 2, arg_word)) { Show_Body(pstm, level, LEFT_AND, arg_word[0]); Pl_Stream_Putc(',', pstm); if (Is_Cut(arg_word[1])) Pl_Stream_Putc(' ', pstm); else Start_Line(pstm, level, ' '); Show_Body(pstm, level, RIGHT_AND, arg_word[1]); return; } if (Check_Structure(body_word, ATOM_CHAR(';'), 2, arg_word)) { if (context != RIGHT_OR) { Pl_Stream_Puts("( ", pstm); level++; } Show_Body(pstm, level, LEFT_OR, arg_word[0]); Start_Line(pstm, level, ';'); Show_Body(pstm, level, RIGHT_OR, arg_word[1]); if (context != RIGHT_OR) { Start_Line(pstm, level - 1, ' '); Pl_Stream_Putc(')', pstm); } return; } soft_cut = 0; if (Check_Structure(body_word, atom_if, 2, arg_word) || (soft_cut = 1, Check_Structure(body_word, atom_soft_if, 2, arg_word))) { if (context != LEFT_OR && context != RIGHT_OR) { Pl_Stream_Puts("( ", pstm); level++; } Show_Body(pstm, level, LEFT_IF, arg_word[0]); Pl_Stream_Puts((soft_cut == 0) ? " ->" : " *-> ", pstm); Start_Line(pstm, level, ' '); Show_Body(pstm, level, RIGHT_IF, arg_word[1]); if (context != LEFT_OR && context != RIGHT_OR) { Start_Line(pstm, level - 1, ' '); Pl_Stream_Putc(')', pstm); } return; } Pl_Write_Term(pstm, -1, prec[context], WRITE_MASK, above_H, body_word); } /*-------------------------------------------------------------------------* * START_LINE * * * *-------------------------------------------------------------------------*/ static void Start_Line(StmInf *pstm, int level, char c_before) { char *p = pl_glob_buff; int i; *p++ = '\n'; *p++ = '\t'; for (i = 0; i < 4 * (level - 1); i++) *p++ = ' '; if (level != 0) { *p++ = c_before; *p++ = ' '; *p++ = ' '; *p++ = ' '; } *p = '\0'; Pl_Stream_Puts(pl_glob_buff, pstm); pl_last_writing = 0; /* ie. W_NOTHING */ } /*-------------------------------------------------------------------------* * PL_NAME_SINGLETON_VARS_1 * * * *-------------------------------------------------------------------------*/ void Pl_Name_Singleton_Vars_1(WamWord start_word) { WamWord word; if (!Pl_Acyclic_Term_1(start_word)) return; singl_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores singletons */ nb_singl_var = 0; Pl_Treat_Vars_Of_Term(start_word, FALSE, Collect_Singleton); if (nb_singl_var == 0) return; word = Pl_Put_Structure(atom_dollar_varname, 1); Pl_Unify_Atom(ATOM_CHAR('_')); /* bind to '$VARNAME'('_') */ while (--singl_var_ptr >= pl_glob_dico_var) { if (*singl_var_ptr & 1) /* marked - not a singleton */ continue; Bind_UV((WamWord *) *singl_var_ptr, word); } } /*-------------------------------------------------------------------------* * COLLECT_SINGLETON * * * *-------------------------------------------------------------------------*/ static Bool Collect_Singleton(WamWord *adr) { PlLong *p; for (p = pl_glob_dico_var; p < singl_var_ptr; p++) if ((*p & ~1) == (PlLong) adr) /* not a singleton */ { if ((*p & 1) == 0) /* not yet marked - mark it */ { *p |= 1; nb_singl_var--; } return TRUE; } if (singl_var_ptr - pl_glob_dico_var >= MAX_VAR_IN_TERM) Pl_Err_Representation(pl_representation_too_many_variables); *singl_var_ptr++ = (PlLong) adr; nb_singl_var++; return TRUE; } /*-------------------------------------------------------------------------* * PL_NAME_QUERY_VARS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Name_Query_Vars_2(WamWord query_list_word, WamWord rest_list_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr, *stc_adr; save_list_word = query_list_word; Pl_Check_For_Un_List(rest_list_word); for (;;) { DEREF(query_list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); stc_adr = UnTag_STC(word); if (tag_mask == TAG_STC_MASK && Functor_And_Arity(stc_adr) == equal_2) { /* form: Name=Value */ DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask != TAG_ATM_MASK) goto unchanged; /* Value is a variable */ DEREF(Arg(stc_adr, 1), word, tag_mask); if (tag_mask != TAG_REF_MASK) goto unchanged; /* Value is a variable */ Pl_Get_Structure(atom_dollar_varname, 1, word); Pl_Unify_Value(Arg(stc_adr, 0)); /* bind Value to '$VARNAME'(Name) */ } else { unchanged: if (!Pl_Get_List(rest_list_word) || !Pl_Unify_Value(Car(lst_adr))) return FALSE; rest_list_word = Pl_Unify_Variable(); } query_list_word = Cdr(lst_adr); } return Pl_Get_Nil(rest_list_word); } #define BIND_WITH_NUMBERVAR (pl_sys_var[0] == 0) /*-------------------------------------------------------------------------* * PL_BIND_VARIABLES_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Bind_Variables_4(WamWord term_word, WamWord exclude_list_word, WamWord from_word, WamWord next_word) { WamWord word, tag_mask; WamWord save_list_word; WamWord *lst_adr, *stc_adr; int i; for (i = 0; i < MAX_VAR_IN_TERM; i++) pl_glob_dico_var[i] = 0; /* pl_glob_dico_var: excluded var ? (0/1) */ nb_to_try = Pl_Rd_Positive_Check(from_word); save_list_word = exclude_list_word; for (;;) { DEREF(exclude_list_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (word == NIL_WORD) break; if (tag_mask != TAG_LST_MASK) Pl_Err_Type(pl_type_list, save_list_word); lst_adr = UnTag_LST(word); DEREF(Car(lst_adr), word, tag_mask); if (Pl_Acyclic_Term_1(word)) Collect_Excluded_Rec(word); stc_adr = UnTag_STC(word); if (tag_mask == TAG_STC_MASK && Functor_And_Arity(stc_adr) == equal_2) { /* form: Name=Value */ DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask == TAG_ATM_MASK) Exclude_A_Var_Number(Var_Name_To_Var_Number(UnTag_ATM(word))); } exclude_list_word = Cdr(lst_adr); } if (Pl_Acyclic_Term_1(term_word)) Pl_Treat_Vars_Of_Term(term_word, FALSE, Bind_Variable); return Pl_Un_Integer_Check(nb_to_try, next_word); } /*-------------------------------------------------------------------------* * VAR_NAME_TO_VAR_NUMBER * * * *-------------------------------------------------------------------------*/ static int Var_Name_To_Var_Number(int atom) { char *p, *q; int n; p = pl_atom_tbl[atom].name; if (*p < 'A' || *p > 'Z') return -1; n = strtol(p + 1, &q, 10); if (*q) return -1; n = n * 26 + *p - 'A'; return n; } /*-------------------------------------------------------------------------* * EXCLUDE_A_VAR_NUMBER * * * *-------------------------------------------------------------------------*/ static void Exclude_A_Var_Number(int n) { if (n >= 0 && n < MAX_VAR_IN_TERM) pl_glob_dico_var[n] = 1; } /*-------------------------------------------------------------------------* * COLLECT_EXCLUDED_REC * * * *-------------------------------------------------------------------------*/ static void Collect_Excluded_Rec(WamWord start_word) { WamWord word, tag_mask; WamWord *adr; WamWord *stc_adr; int i; terminal_rec: DEREF(start_word, word, tag_mask); if (tag_mask == TAG_LST_MASK) { adr = UnTag_LST(word); adr = &Car(adr); Collect_Excluded_Rec(*adr++); start_word = *adr; goto terminal_rec; } if (tag_mask != TAG_STC_MASK) return; stc_adr = UnTag_STC(word); if (Functor_And_Arity(stc_adr) == dollar_var_1) { DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask != TAG_INT_MASK) goto normal_compound; Exclude_A_Var_Number(UnTag_INT(word)); return; } if (Functor_And_Arity(stc_adr) == dollar_varname_1) { DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask != TAG_ATM_MASK) goto normal_compound; Exclude_A_Var_Number(Var_Name_To_Var_Number(UnTag_ATM(word))); return; } normal_compound: i = Arity(stc_adr); adr = &Arg(stc_adr, 0); while (--i) Collect_Excluded_Rec(*adr++); start_word = *adr; goto terminal_rec; } /*-------------------------------------------------------------------------* * BIND_VARIABLE * * * *-------------------------------------------------------------------------*/ static Bool Bind_Variable(WamWord *adr, WamWord word) { int i, j; char buff[16]; while (pl_glob_dico_var[nb_to_try] && nb_to_try < MAX_VAR_IN_TERM) nb_to_try++; if (BIND_WITH_NUMBERVAR) { Pl_Get_Structure(atom_dollar_var, 1, word); Pl_Unify_Integer(nb_to_try++); return TRUE; } i = nb_to_try % 26; j = nb_to_try / 26; nb_to_try++; buff[0] = 'A' + i; if (j) sprintf(buff + 1, "%d", j); else buff[1] = '\0'; Pl_Get_Structure(atom_dollar_varname, 1, word); Pl_Unify_Atom(Pl_Create_Allocate_Atom(buff)); return TRUE; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/random.pl������������������������������������������������������������������0000644�0001750�0001750�00000006164�13021324543�015123� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : random.pl * * Descr.: random number generator management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_random'. randomize :- '$call_c'('Pl_M_Randomize'). set_seed(Seed) :- set_bip_name(set_seed, 1), '$call_c'('Pl_Set_Seed_1'(Seed)). get_seed(Seed) :- set_bip_name(get_seed, 1), '$call_c_test'('Pl_Get_Seed_1'(Seed)). random(N) :- set_bip_name(random, 1), '$call_c'('Pl_Random_1'(N)). random(L, U, N) :- set_bip_name(random, 3), '$call_c_test'('Pl_Random_3'(L, U, N)). ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/list.wam�������������������������������������������������������������������0000644�0001750�0001750�00000052517�13021356407�014776� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������% compiler: GNU Prolog 1.4.5 % file : list.pl file_name('/home/diaz/GP/src/BipsPl/list.pl'). predicate(system:'$use_list'/0,41,static,private,monofile,built_in,[ proceed]). predicate(system:append/3,50,static,private,monofile,built_in,[ call_c('Pl_Append_3',[boolean],[x(0),x(1),x(2)]), proceed]). predicate(system:'$append_alt'/0,54,static,private,monofile,built_in,[ call_c('Pl_Append_Alt_0',[boolean],[]), proceed]). predicate(system:member/2,67,static,private,monofile,built_in,[ call_c('Pl_Member_2',[boolean],[]), proceed]). predicate(system:'$member_alt'/0,70,static,private,monofile,built_in,[ call_c('Pl_Member_Alt_0',[boolean],[]), proceed]). predicate(system:memberchk/2,84,static,private,monofile,built_in,[ call_c('Pl_Memberchk_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:reverse/2,103,static,private,monofile,built_in,[ call_c('Pl_Reverse_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$reverse_alt'/0,106,static,private,monofile,built_in,[ call_c('Pl_Reverse_Alt_0',[boolean],[]), proceed]). predicate(system:delete/3,112,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_nil(2), proceed, label(4), retry_me_else(6), label(5), get_list(0), unify_variable(x(4)), unify_variable(x(0)), call_c('Pl_Blt_Term_Eq',[fast_call,boolean],[x(4),x(1)]), cut(x(3)), execute(delete/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_value(x(3)), unify_variable(x(2)), execute(delete/3)]). predicate(system:select/3,125,static,private,monofile,built_in,[ try_me_else(1), get_list(1), unify_local_value(x(0)), unify_local_value(x(2)), proceed, label(1), trust_me_else_fail, get_list(1), unify_variable(x(3)), unify_variable(x(1)), get_list(2), unify_value(x(3)), unify_variable(x(2)), execute(select/3)]). predicate(system:subtract/3,134,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_nil(2), proceed, label(4), retry_me_else(6), label(5), allocate(4), get_variable(y(1),1), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_variable(y(3),3), put_value(y(1),1), call(memberchk/2), cut(y(3)), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute(subtract/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(3)), unify_variable(x(0)), get_list(2), unify_value(x(3)), unify_variable(x(2)), execute(subtract/3)]). predicate(system:permutation/2,146,static,private,monofile,built_in,[ try_me_else(1), get_nil(0), get_nil(1), proceed, label(1), trust_me_else_fail, allocate(2), get_variable(x(2),0), get_list(1), unify_variable(x(0)), unify_variable(y(0)), put_value(x(2),1), put_variable(y(1),2), call(select/3), put_unsafe_value(y(1),0), put_value(y(0),1), deallocate, execute(permutation/2)]). predicate(system:prefix/2,156,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(2)), unify_variable(x(0)), get_list(1), unify_value(x(2)), unify_variable(x(1)), execute(prefix/2)]). predicate(system:suffix/2,164,static,private,monofile,built_in,[ try_me_else(1), get_value(x(1),0), proceed, label(1), trust_me_else_fail, get_list(1), unify_void(1), unify_variable(x(1)), execute(suffix/2)]). predicate(system:sublist/2,172,static,private,monofile,built_in,[ try_me_else(1), get_value(x(1),0), proceed, label(1), trust_me_else_fail, get_variable(x(2),0), get_list(1), unify_variable(x(1)), unify_variable(x(0)), execute('$sublist1'/3)]). predicate(system:'$sublist1'/3,178,static,private,monofile,built_in,[ try_me_else(1), get_value(x(2),0), proceed, label(1), trust_me_else_fail, switch_on_term(3,fail,fail,2,fail), label(2), try(4), trust(6), label(3), try_me_else(5), label(4), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$sublist1'/3), label(5), trust_me_else_fail, label(6), get_variable(x(3),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), get_list(2), unify_local_value(x(3)), unify_variable(x(2)), execute('$sublist1'/3)]). predicate(system:last/2,189,static,private,monofile,built_in,[ get_variable(x(2),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$last1'/3)]). predicate(system:'$last1'/3,192,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$last1'/3)]). predicate(system:length/2,227,static,private,monofile,built_in,[ call_c('Pl_Length_2',[boolean],[x(0),x(1)]), proceed]). predicate(system:'$length_alt'/0,231,static,private,monofile,built_in,[ call_c('Pl_Length_Alt_0',[boolean],[]), proceed]). predicate(system:nth/3,265,static,private,monofile,built_in,[ execute(nth1/3)]). predicate(system:nth1/3,268,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), cut(x(3)), call_c('Pl_Nth0_3',[boolean,by_value],[x(0),x(1),x(2),1]), proceed, label(1), trust_me_else_fail, get_variable(x(3),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(3)]), put_value(x(1),0), put_value(x(2),1), put_integer(1,2), execute('$nth_gener'/4)]). predicate(system:nth0/3,277,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), call_c('Pl_Blt_Integer',[fast_call,boolean],[x(0)]), cut(x(3)), call_c('Pl_Nth0_3',[boolean,by_value],[x(0),x(1),x(2),0]), proceed, label(1), trust_me_else_fail, get_variable(x(3),0), call_c('Pl_Blt_Var',[fast_call,boolean],[x(3)]), put_value(x(1),0), put_value(x(2),1), put_integer(0,2), execute('$nth_gener'/4)]). predicate(system:'$nth_gener'/4,287,static,private,monofile,built_in,[ switch_on_term(2,fail,fail,1,fail), label(1), try(3), trust(5), label(2), try_me_else(4), label(3), get_value(x(3),2), get_list(0), unify_local_value(x(1)), unify_void(1), proceed, label(4), trust_me_else_fail, label(5), get_list(0), unify_void(1), unify_variable(x(0)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(2),2), call_c('Pl_Fct_Inc',[fast_call,x(2)],[x(2)]), execute('$nth_gener'/4)]). predicate(system:max_list/2,297,static,private,monofile,built_in,[ get_variable(x(2),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$max_list1'/3)]). predicate(system:'$max_list1'/3,300,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), proceed, label(4), retry_me_else(6), label(5), get_list(0), unify_variable(x(4)), unify_variable(x(0)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[=<,2]), math_load_value(x(4),4), math_load_value(x(1),5), call_c('Pl_Blt_Lte',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), execute('$max_list1'/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$max_list1'/3)]). predicate(system:min_list/2,312,static,private,monofile,built_in,[ get_variable(x(2),1), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$min_list1'/3)]). predicate(system:'$min_list1'/3,315,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), switch_on_term(2,3,fail,1,fail), label(1), try(5), trust(7), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), proceed, label(4), retry_me_else(6), label(5), get_list(0), unify_variable(x(4)), unify_variable(x(0)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[>=,2]), math_load_value(x(4),4), math_load_value(x(1),5), call_c('Pl_Blt_Gte',[fast_call,boolean],[x(4),x(5)]), cut(x(3)), execute('$min_list1'/3), label(6), trust_me_else_fail, label(7), get_list(0), unify_variable(x(1)), unify_variable(x(0)), execute('$min_list1'/3)]). predicate(system:sum_list/2,328,static,private,monofile,built_in,[ put_value(x(1),2), put_integer(0,1), execute('$sum_list1'/3)]). predicate(system:'$sum_list1'/3,331,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_value(x(2),1), proceed, label(3), trust_me_else_fail, label(4), get_list(0), unify_variable(x(3)), unify_variable(x(0)), call_c('Pl_Set_Bip_Name_Untagged_2',[by_value],[is,2]), math_load_value(x(3),3), math_load_value(x(1),1), call_c('Pl_Fct_Add',[fast_call,x(1)],[x(3),x(1)]), execute('$sum_list1'/3)]). predicate(system:flatten/2,339,static,private,monofile,built_in,[ pragma_arity(3), get_current_choice(x(2)), allocate(3), get_variable(y(0),1), get_variable(y(1),2), put_nil(1), put_variable(y(2),2), call('$flatten'/3), cut(y(1)), put_value(y(0),0), get_value(y(2),0), deallocate, proceed]). predicate(system:'$flatten'/3,343,static,private,monofile,built_in,[ pragma_arity(4), get_current_choice(x(3)), try_me_else(1), get_list(2), unify_local_value(x(0)), unify_local_value(x(1)), call_c('Pl_Blt_Var',[fast_call,boolean],[x(0)]), cut(x(3)), proceed, label(1), retry_me_else(6), switch_on_term(2,3,fail,5,fail), label(2), try_me_else(4), label(3), get_nil(0), get_value(x(2),1), cut(x(3)), proceed, label(4), trust_me_else_fail, label(5), allocate(3), get_variable(y(1),1), get_list(0), unify_variable(x(0)), unify_variable(y(0)), cut(x(3)), put_variable(y(2),1), call('$flatten'/3), put_value(y(0),0), put_value(y(1),1), put_unsafe_value(y(2),2), deallocate, execute('$flatten'/3), label(6), trust_me_else_fail, get_list(2), unify_local_value(x(0)), unify_local_value(x(1)), proceed]). predicate(system:maplist/2,362,static,private,monofile,built_in,[ get_variable(x(2),1), get_variable(x(1),0), put_value(x(2),0), execute('$maplist'/2)]). predicate(system:'$maplist'/2,365,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), proceed, label(3), trust_me_else_fail, label(4), allocate(2), get_variable(y(1),1), get_list(0), unify_variable(x(1)), unify_variable(y(0)), put_value(y(1),0), put_meta_term(system,0,0), call(call/2), put_value(y(0),0), put_value(y(1),1), deallocate, execute('$maplist'/2)]). predicate(system:maplist/3,374,static,private,monofile,built_in,[ get_variable(x(3),2), get_variable(x(2),0), put_value(x(1),0), put_value(x(3),1), execute('$maplist'/3)]). predicate(system:'$maplist'/3,377,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), proceed, label(3), trust_me_else_fail, label(4), allocate(3), get_variable(y(2),2), get_list(0), unify_variable(x(0)), unify_variable(y(0)), get_list(1), unify_variable(x(2)), unify_variable(y(1)), put_value(x(0),1), put_value(y(2),0), put_meta_term(system,0,0), call(call/3), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), deallocate, execute('$maplist'/3)]). predicate(system:maplist/4,386,static,private,monofile,built_in,[ get_variable(x(4),3), get_variable(x(3),0), put_value(x(1),0), put_value(x(2),1), put_value(x(4),2), execute('$maplist'/4)]). predicate(system:'$maplist'/4,389,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), proceed, label(3), trust_me_else_fail, label(4), allocate(4), get_variable(y(3),3), get_list(0), unify_variable(x(4)), unify_variable(y(0)), get_list(1), unify_variable(x(0)), unify_variable(y(1)), get_list(2), unify_variable(x(3)), unify_variable(y(2)), put_value(x(4),1), put_value(x(0),2), put_value(y(3),0), put_meta_term(system,0,0), call(call/4), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), deallocate, execute('$maplist'/4)]). predicate(system:maplist/5,398,static,private,monofile,built_in,[ get_variable(x(5),4), get_variable(x(4),0), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(5),3), execute('$maplist'/5)]). predicate(system:'$maplist'/5,401,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), proceed, label(3), trust_me_else_fail, label(4), allocate(5), get_variable(y(4),4), get_list(0), unify_variable(x(6)), unify_variable(y(0)), get_list(1), unify_variable(x(5)), unify_variable(y(1)), get_list(2), unify_variable(x(0)), unify_variable(y(2)), get_list(3), unify_variable(x(4)), unify_variable(y(3)), put_value(x(6),1), put_value(x(5),2), put_value(x(0),3), put_value(y(4),0), put_meta_term(system,0,0), call(call/5), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), deallocate, execute('$maplist'/5)]). predicate(system:maplist/6,410,static,private,monofile,built_in,[ get_variable(x(6),5), get_variable(x(5),0), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), put_value(x(6),4), execute('$maplist'/6)]). predicate(system:'$maplist'/6,413,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), get_nil(4), proceed, label(3), trust_me_else_fail, label(4), allocate(6), get_variable(y(5),5), get_list(0), unify_variable(x(8)), unify_variable(y(0)), get_list(1), unify_variable(x(7)), unify_variable(y(1)), get_list(2), unify_variable(x(6)), unify_variable(y(2)), get_list(3), unify_variable(x(0)), unify_variable(y(3)), get_list(4), unify_variable(x(5)), unify_variable(y(4)), put_value(x(8),1), put_value(x(7),2), put_value(x(6),3), put_value(x(0),4), put_value(y(5),0), put_meta_term(system,0,0), call(call/6), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), deallocate, execute('$maplist'/6)]). predicate(system:maplist/7,422,static,private,monofile,built_in,[ get_variable(x(7),6), get_variable(x(6),0), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), put_value(x(5),4), put_value(x(7),5), execute('$maplist'/7)]). predicate(system:'$maplist'/7,425,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), get_nil(4), get_nil(5), proceed, label(3), trust_me_else_fail, label(4), allocate(7), get_variable(y(6),6), get_list(0), unify_variable(x(10)), unify_variable(y(0)), get_list(1), unify_variable(x(9)), unify_variable(y(1)), get_list(2), unify_variable(x(8)), unify_variable(y(2)), get_list(3), unify_variable(x(7)), unify_variable(y(3)), get_list(4), unify_variable(x(0)), unify_variable(y(4)), get_list(5), unify_variable(x(6)), unify_variable(y(5)), put_value(x(10),1), put_value(x(9),2), put_value(x(8),3), put_value(x(7),4), put_value(x(0),5), put_value(y(6),0), put_meta_term(system,0,0), call(call/7), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), put_value(y(6),6), deallocate, execute('$maplist'/7)]). predicate(system:maplist/8,434,static,private,monofile,built_in,[ get_variable(x(8),7), get_variable(x(7),0), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), put_value(x(5),4), put_value(x(6),5), put_value(x(8),6), execute('$maplist'/8)]). predicate(system:'$maplist'/8,437,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), get_nil(4), get_nil(5), get_nil(6), proceed, label(3), trust_me_else_fail, label(4), allocate(8), get_variable(y(7),7), get_list(0), unify_variable(x(12)), unify_variable(y(0)), get_list(1), unify_variable(x(11)), unify_variable(y(1)), get_list(2), unify_variable(x(10)), unify_variable(y(2)), get_list(3), unify_variable(x(9)), unify_variable(y(3)), get_list(4), unify_variable(x(8)), unify_variable(y(4)), get_list(5), unify_variable(x(0)), unify_variable(y(5)), get_list(6), unify_variable(x(7)), unify_variable(y(6)), put_value(x(12),1), put_value(x(11),2), put_value(x(10),3), put_value(x(9),4), put_value(x(8),5), put_value(x(0),6), put_value(y(7),0), put_meta_term(system,0,0), call(call/8), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), put_value(y(6),6), put_value(y(7),7), deallocate, execute('$maplist'/8)]). predicate(system:maplist/9,446,static,private,monofile,built_in,[ get_variable(x(9),8), get_variable(x(8),0), put_value(x(1),0), put_value(x(2),1), put_value(x(3),2), put_value(x(4),3), put_value(x(5),4), put_value(x(6),5), put_value(x(7),6), put_value(x(9),7), execute('$maplist'/9)]). predicate(system:'$maplist'/9,449,static,private,monofile,built_in,[ switch_on_term(1,2,fail,4,fail), label(1), try_me_else(3), label(2), get_nil(0), get_nil(1), get_nil(2), get_nil(3), get_nil(4), get_nil(5), get_nil(6), get_nil(7), proceed, label(3), trust_me_else_fail, label(4), allocate(9), get_variable(y(8),8), get_list(0), unify_variable(x(14)), unify_variable(y(0)), get_list(1), unify_variable(x(13)), unify_variable(y(1)), get_list(2), unify_variable(x(12)), unify_variable(y(2)), get_list(3), unify_variable(x(11)), unify_variable(y(3)), get_list(4), unify_variable(x(10)), unify_variable(y(4)), get_list(5), unify_variable(x(9)), unify_variable(y(5)), get_list(6), unify_variable(x(0)), unify_variable(y(6)), get_list(7), unify_variable(x(1)), unify_variable(y(7)), put_meta_term(system,1,8), put_value(x(14),1), put_value(x(13),2), put_value(x(12),3), put_value(x(11),4), put_value(x(10),5), put_value(x(9),6), put_value(x(0),7), put_value(y(8),0), call(call/9), put_value(y(0),0), put_value(y(1),1), put_value(y(2),2), put_value(y(3),3), put_value(y(4),4), put_value(y(5),5), put_value(y(6),6), put_value(y(7),7), put_value(y(8),8), deallocate, execute('$maplist'/9)]). directive(357,system,[ put_atom(user,0), put_structure(maplist/2,1), unify_integer(1), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(358,system,[ put_atom(user,0), put_structure(maplist/3,1), unify_integer(2), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(359,system,[ put_atom(user,0), put_structure(maplist/4,1), unify_integer(3), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). directive(360,system,[ put_atom(user,0), put_structure(maplist/5,1), unify_integer(4), unify_atom(?), unify_atom(?), unify_atom(?), unify_atom(?), execute('$declare_meta_predicate'/2)]). ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/Makefile.in����������������������������������������������������������������0000644�0001750�0001750�00000013735�13021324543�015355� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������MAKE_SOCKETS_OBJS = @MAKE_SOCKETS_OBJS@ MAKE_LE_INTERF_OBJS = @MAKE_LE_INTERF_OBJS@ LIB_BIPS_PL = @LIB_BIPS_PL@ LIB_ENGINE_PL = @LIB_ENGINE_PL@ LIB_LINEDIT = @LIB_LINEDIT@ GPLC = @GPLC@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ CFLAGS_UNSIGNED_CHAR = @CFLAGS_UNSIGNED_CHAR@ AR_RC = @AR_RC@ RANLIB = @RANLIB@ SOCKETS_OBJS = sockets@OBJ_SUFFIX@ sockets_c@OBJ_SUFFIX@ NO_SOCKETS_OBJS = no_sockets@OBJ_SUFFIX@ LE_INTERF_OBJS = le_interf@OBJ_SUFFIX@ le_interf_c@OBJ_SUFFIX@ NO_LE_INTERF_OBJS = no_le_interf@OBJ_SUFFIX@ LIBNAME = $(LIB_BIPS_PL) OBJLIB = error_supp@OBJ_SUFFIX@ \ c_supp@OBJ_SUFFIX@ \ foreign_supp@OBJ_SUFFIX@ \ pred_supp@OBJ_SUFFIX@ \ term_supp@OBJ_SUFFIX@ \ stream_supp@OBJ_SUFFIX@ \ scan_supp@OBJ_SUFFIX@ \ parse_supp@OBJ_SUFFIX@ \ write_supp@OBJ_SUFFIX@ \ dynam_supp@OBJ_SUFFIX@ \ callinf_supp@OBJ_SUFFIX@ \ bc_supp@OBJ_SUFFIX@ \ foreign@OBJ_SUFFIX@ \ pl_error@OBJ_SUFFIX@ \ utils@OBJ_SUFFIX@ \ unify@OBJ_SUFFIX@ \ assert@OBJ_SUFFIX@ assert_c@OBJ_SUFFIX@ \ read@OBJ_SUFFIX@ read_c@OBJ_SUFFIX@ \ write@OBJ_SUFFIX@ write_c@OBJ_SUFFIX@ print@OBJ_SUFFIX@ \ const_io@OBJ_SUFFIX@ const_io_c@OBJ_SUFFIX@ \ oper@OBJ_SUFFIX@ oper_c@OBJ_SUFFIX@ \ pred@OBJ_SUFFIX@ pred_c@OBJ_SUFFIX@ \ atom@OBJ_SUFFIX@ atom_c@OBJ_SUFFIX@ \ control@OBJ_SUFFIX@ control_c@OBJ_SUFFIX@ \ call@OBJ_SUFFIX@ \ call_args@OBJ_SUFFIX@ call_args_c@OBJ_SUFFIX@ \ catch@OBJ_SUFFIX@ throw@OBJ_SUFFIX@ throw_c@OBJ_SUFFIX@ \ flag_supp@OBJ_SUFFIX@ flag@OBJ_SUFFIX@ flag_c@OBJ_SUFFIX@ \ arith_inl@OBJ_SUFFIX@ arith_inl_c@OBJ_SUFFIX@ \ type_inl@OBJ_SUFFIX@ type_inl_c@OBJ_SUFFIX@ \ term_inl@OBJ_SUFFIX@ term_inl_c@OBJ_SUFFIX@ \ g_var_inl@OBJ_SUFFIX@ g_var_inl_c@OBJ_SUFFIX@ \ all_solut@OBJ_SUFFIX@ all_solut_c@OBJ_SUFFIX@ \ sort@OBJ_SUFFIX@ sort_c@OBJ_SUFFIX@ \ list@OBJ_SUFFIX@ list_c@OBJ_SUFFIX@ \ stat@OBJ_SUFFIX@ stat_c@OBJ_SUFFIX@ \ stream@OBJ_SUFFIX@ stream_c@OBJ_SUFFIX@ \ file@OBJ_SUFFIX@ file_c@OBJ_SUFFIX@ \ char_io@OBJ_SUFFIX@ char_io_c@OBJ_SUFFIX@ \ dec10io@OBJ_SUFFIX@ \ format@OBJ_SUFFIX@ format_c@OBJ_SUFFIX@ \ os_interf@OBJ_SUFFIX@ os_interf_c@OBJ_SUFFIX@ \ expand@OBJ_SUFFIX@ expand_c@OBJ_SUFFIX@ \ consult@OBJ_SUFFIX@ consult_c@OBJ_SUFFIX@ \ pretty@OBJ_SUFFIX@ pretty_c@OBJ_SUFFIX@ \ random@OBJ_SUFFIX@ random_c@OBJ_SUFFIX@ \ top_level@OBJ_SUFFIX@ top_level_c@OBJ_SUFFIX@ \ debugger@OBJ_SUFFIX@ debugger_c@OBJ_SUFFIX@ \ src_rdr@OBJ_SUFFIX@ src_rdr_c@OBJ_SUFFIX@ \ all_pl_bips@OBJ_SUFFIX@ \ $(MAKE_SOCKETS_OBJS) \ $(MAKE_LE_INTERF_OBJS) .SUFFIXES: .SUFFIXES: @OBJ_SUFFIX@ .c .wam .pl $(SUFFIXES) .pl.wam: $(GPLC) -W $(GPLCFLAGS) --no-redef-error $*.pl .wam@OBJ_SUFFIX@: $(GPLC) -c $*.wam .c@OBJ_SUFFIX@: $(GPLC) -c -C '$(CFLAGS) $(CFLAGS_UNSIGNED_CHAR)' $*.c $(LIBNAME): $(OBJLIB) no_sockets.wam sockets.wam no_le_interf.wam le_interf.wam rm -f $(LIBNAME) $(AR_RC)@AR_SEP@$(LIBNAME) $(OBJLIB) $(RANLIB) $(LIBNAME) clean: rm -f *@OBJ_SUFFIX@ *.ilk *.pdb *.pch *.idb *.exp $(LIBNAME) distclean: clean # for test t.wam: t.pl t@EXE_SUFFIX@: t@OBJ_SUFFIX@ t_c@OBJ_SUFFIX@ ../EnginePl/$(LIB_ENGINE_PL) $(LIBNAME) \ ../Linedit/$(LIB_LINEDIT) $(GPLC) -o t@EXE_SUFFIX@ t@OBJ_SUFFIX@ t_c@OBJ_SUFFIX@ --no-fd-lib # depending on ../EnginePl/gp_config.h error_supp@OBJ_SUFFIX@: ../EnginePl/gp_config.h stream_supp@OBJ_SUFFIX@: ../EnginePl/gp_config.h flag_c@OBJ_SUFFIX@: ../EnginePl/gp_config.h flag_c@OBJ_SUFFIX@: ../EnginePl/gp_config.h # depending on dynam_supp.h dynam_supp@OBJ_SUFFIX@: dynam_supp.h bc_supp@OBJ_SUFFIX@: dynam_supp.h assert_c@OBJ_SUFFIX@: dynam_supp.h # depending on flag_supp.h flag_supp@OBJ_SUFFIX@: flag_supp.h flag_c@OBJ_SUFFIX@: flag_supp.h stream_supp@OBJ_SUFFIX@: flag_supp.h consult_c@OBJ_SUFFIX@: flag_supp.h foreign.wam: foreign.pl all_pl_bips.wam: all_pl_bips.pl all_solut.wam: all_solut.pl arith_inl.wam: arith_inl.pl assert.wam: assert.pl atom.wam: atom.pl call.wam: call.pl call_args.wam: call_args.pl catch.wam: catch.pl char_io.wam: char_io.pl const_io.wam: const_io.pl consult.wam: consult.pl control.wam: control.pl expand.wam: expand.pl debugger.wam: debugger.pl $(GPLC) -W $(GPLCFLAGS) --no-redef-error --fast-math debugger.pl dec10io.wam: dec10io.pl file.wam: file.pl flag.wam: flag.pl format.wam: format.pl g_var_inl.wam: g_var_inl.pl le_interf.wam: le_interf.pl list.wam: list.pl stat.wam: stat.pl no_le_interf.wam:no_le_interf.pl no_sockets.wam: no_sockets.pl oper.wam: oper.pl os_interf.wam: os_interf.pl pl_error.wam: pl_error.pl pred.wam: pred.pl pretty.wam: pretty.pl random.wam: random.pl print.wam: print.pl read.wam: read.pl reg_alloc.wam: reg_alloc.pl sockets.wam: sockets.pl sort.wam: sort.pl stream.wam: stream.pl term_inl.wam: term_inl.pl throw.wam: throw.pl top_level.wam: top_level.pl type_inl.wam: type_inl.pl unify.wam: unify.pl utils.wam: utils.pl write.wam: write.pl src_rdr.wam: src_rdr.pl check: @../Pl2Wam/check_boot -a [a-z][a-z]*.wam && echo Bootstrap Prolog Bips OK # test: read alone RCFLAGS=$(CFLAGS) -I../EnginePl -DFOR_EXTERNAL_USE ROBJS=scan_supp.o parse_supp.o /tmp/stream_supp.o /tmp/write_supp.o /tmp/stream_supp.o: stream_supp.c $(GPLC) -C "$(RCFLAGS)" -c stream_supp.c -o /tmp/stream_supp.o /tmp/write_supp.o: write_supp.c $(GPLC) -C "$(RCFLAGS)" -c write_supp.c -o /tmp/write_supp.o r: r.o $(ROBJS) ../EnginePl/$(LIB_ENGINE_PL) $(GPLC) -o r r.o $(ROBJS) --no-pl-lib �����������������������������������gprolog-1.4.5/src/BipsPl/list.pl��������������������������������������������������������������������0000644�0001750�0001750�00000021630�13021324543�014611� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : list.pl * * Descr.: list library * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_list'. /* append([], L, L). append([H|T1], List, [H|T2]) :- append(T1, List, T2). */ append(L1, L2, L3) :- '$call_c_test'('Pl_Append_3'(L1, L2, L3)). '$append_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Append_Alt_0'). /* member(X, [H|T]) :- ( X = H ; member(X, T) ). */ member(_X, _L) :- '$call_c_test'('Pl_Member_2'). '$member_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Member_Alt_0'). /* memberchk(X, L) :- ( X = H, ! ; memberchk(X, T) ). */ memberchk(X, L) :- '$call_c_test'('Pl_Memberchk_2'(X, L)). /* reverse([], []). reverse([H|T], L) :- '$reverse1'(T, L, [H]). '$reverse1'([], L, L). '$reverse1'([H|T], L, L1) :- '$reverse1'(T, L, [H|L1]). */ reverse(L1, L2) :- '$call_c_test'('Pl_Reverse_2'(L1, L2)). '$reverse_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Reverse_Alt_0'). delete([], _, []). delete([H|T], X, L) :- H == X, !, delete(T, X, L). delete([H|T], X, [H|L]) :- delete(T, X, L). select(X, [X|T], T). select(X, [H|T1], [H|T2]) :- select(X, T1, T2). subtract([], _, []). subtract([X|L1], L2, L3) :- memberchk(X, L2), !, subtract(L1, L2, L3). subtract([X|L1], L2, [X|L3]) :- subtract(L1, L2, L3). permutation([], []). permutation(L, [H|T]) :- select(H, L, Rest), permutation(Rest, T). prefix([], _). prefix([X|T], [X|T1]) :- prefix(T, T1). suffix(L, L). suffix(X, [_|T]) :- suffix(X, T). sublist(L, L). sublist(Sub, [H|T]) :- '$sublist1'(T, H, Sub). '$sublist1'(Sub, _, Sub). '$sublist1'([H|T], _, Sub) :- '$sublist1'(T, H, Sub). '$sublist1'([H|T], X, [X|Sub]) :- '$sublist1'(T, H, Sub). last([H|T], X) :- '$last1'(T, H, X). '$last1'([], X, X). '$last1'([H|T], _, X) :- '$last1'(T, H, X). /* length(L, N) :- integer(N), !, N >= 0, '$make_list'(N, L). length(L, N) :- '$length'(L, 0, N). '$length'([], N, N). '$length'([_|L], M, N) :- M1 is M + 1, '$length'(L, M1, N). '$make_list'(0, []) :- !. '$make_list'(N, [_|L]) :- N1 is N - 1, '$make_list'(N1, L). */ length(L, N) :- '$call_c_test'('Pl_Length_2'(L, N)). '$length_alt' :- % used by C code to create a choice-point '$call_c_test'('Pl_Length_Alt_0'). /* nth(N, L, X) :- integer(N), !, N >= 1, '$nth1'(N, L, X). nth(N, L, X) :- var(N), '$nth2'(L, X, 1, N). '$nth1'(1, [X|_], X) :- !. '$nth1'(N, [_|T], X) :- N1 is N - 1, '$nth1'(N1, T, X). '$nth2'([X|_], X, N, N). '$nth2'([_|T], X, I, N) :- I1 is I + 1, '$nth2'(T, X, I1, N). */ nth(N, L, X) :- nth1(N, L, X). nth1(N, L, X) :- integer(N), !, '$call_c'('Pl_Nth0_3'(N, L, X, 1), [boolean, by_value]). nth1(N, L, X) :- var(N), '$nth_gener'(L, X, 1, N). nth0(N, L, X) :- integer(N), !, '$call_c'('Pl_Nth0_3'(N, L, X, 0), [boolean, by_value]). nth0(N, L, X) :- var(N), '$nth_gener'(L, X, 0, N). '$nth_gener'([X|_], X, N, N). '$nth_gener'([_|L], X, I, N) :- I1 is I + 1, '$nth_gener'(L, X, I1, N). max_list([H|T], Max) :- '$max_list1'(T, H, Max). '$max_list1'([], Max, Max). '$max_list1'([H|T], X, Max) :- H =< X, !, '$max_list1'(T, X, Max). '$max_list1'([H|T], _, Max) :- '$max_list1'(T, H, Max). min_list([H|T], Min) :- '$min_list1'(T, H, Min). '$min_list1'([], Min, Min). '$min_list1'([H|T], X, Min) :- H >= X, !, '$min_list1'(T, X, Min). '$min_list1'([H|T], _, Min) :- '$min_list1'(T, H, Min). sum_list(L, Sum) :- '$sum_list1'(L, 0, Sum). '$sum_list1'([], Sum, Sum). '$sum_list1'([H|T], Sum0, Sum) :- Sum1 is H + Sum0, '$sum_list1'(T, Sum1, Sum). flatten(List, FlatList) :- '$flatten'(List, [], FlatList0), !, FlatList = FlatList0. '$flatten'(Var, Tl, [Var|Tl]) :- var(Var), !. '$flatten'([], Tl, Tl) :- !. '$flatten'([Hd|Tl], Tail, List) :- !, '$flatten'(Hd, FlatHeadTail, List), '$flatten'(Tl, Tail, FlatHeadTail). '$flatten'(NonList, Tl, [NonList|Tl]). :- meta_predicate(maplist(1, ?)). :- meta_predicate(maplist(2, ?, ?)). :- meta_predicate(maplist(3, ?, ?, ?)). :- meta_predicate(maplist(4, ?, ?, ?, ?)). maplist(Goal, List) :- '$maplist'(List, Goal). '$maplist'([], _). '$maplist'([X|List], Goal) :- call(Goal, X), '$maplist'(List, Goal). maplist(Goal, L1, L2) :- '$maplist'(L1, L2, Goal). '$maplist'([], [], _). '$maplist'([X1|L1], [X2|L2], Goal) :- call(Goal, X1, X2), '$maplist'(L1, L2, Goal). maplist(Goal, L1, L2, L3) :- '$maplist'(L1, L2, L3, Goal). '$maplist'([], [], [], _). '$maplist'([X1|L1], [X2|L2], [X3|L3], Goal) :- call(Goal, X1, X2, X3), '$maplist'(L1, L2, L3, Goal). maplist(Goal, L1, L2, L3, L4) :- '$maplist'(L1, L2, L3, L4, Goal). '$maplist'([], [], [], [], _). '$maplist'([X1|L1], [X2|L2], [X3|L3], [X4|L4], Goal) :- call(Goal, X1, X2, X3, X4), '$maplist'(L1, L2, L3, L4, Goal). maplist(Goal, L1, L2, L3, L4, L5) :- '$maplist'(L1, L2, L3, L4, L5, Goal). '$maplist'([], [], [], [], [], _). '$maplist'([X1|L1], [X2|L2], [X3|L3], [X4|L4], [X5|L5], Goal) :- call(Goal, X1, X2, X3, X4, X5), '$maplist'(L1, L2, L3, L4, L5, Goal). maplist(Goal, L1, L2, L3, L4, L5, L6) :- '$maplist'(L1, L2, L3, L4, L5, L6, Goal). '$maplist'([], [], [], [], [], [], _). '$maplist'([X1|L1], [X2|L2], [X3|L3], [X4|L4], [X5|L5], [X6|L6], Goal) :- call(Goal, X1, X2, X3, X4, X5, X6), '$maplist'(L1, L2, L3, L4, L5, L6, Goal). maplist(Goal, L1, L2, L3, L4, L5, L6, L7) :- '$maplist'(L1, L2, L3, L4, L5, L6, L7, Goal). '$maplist'([], [], [], [], [], [], [], _). '$maplist'([X1|L1], [X2|L2], [X3|L3], [X4|L4], [X5|L5], [X6|L6], [X7|L7], Goal) :- call(Goal, X1, X2, X3, X4, X5, X6, X7), '$maplist'(L1, L2, L3, L4, L5, L6, L7, Goal). maplist(Goal, L1, L2, L3, L4, L5, L6, L7, L8) :- '$maplist'(L1, L2, L3, L4, L5, L6, L7, L8, Goal). '$maplist'([], [], [], [], [], [], [], [], _). '$maplist'([X1|L1], [X2|L2], [X3|L3], [X4|L4], [X5|L5], [X6|L6], [X7|L7], [X8|L8], Goal) :- call(Goal, X1, X2, X3, X4, X5, X6, X7, X8), '$maplist'(L1, L2, L3, L4, L5, L6, L7, L8, Goal). ��������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/write.pl�������������������������������������������������������������������0000644�0001750�0001750�00000016135�13021324543�014774� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : write.pl * * Descr.: term output (write/1 and friends) management * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ :- built_in. '$use_write'. /* warning: if you change this file check also definitions in const_io.pl */ write(Term) :- set_bip_name(write, 1), '$call_c'('Pl_Write_1'(Term)). write(SorA, Term) :- set_bip_name(write, 2), '$call_c'('Pl_Write_2'(SorA, Term)). writeq(Term) :- set_bip_name(writeq, 1), '$call_c'('Pl_Writeq_1'(Term)). writeq(SorA, Term) :- set_bip_name(writeq, 2), '$call_c'('Pl_Writeq_2'(SorA, Term)). write_canonical(Term) :- set_bip_name(write_canonical, 1), '$call_c'('Pl_Write_Canonical_1'(Term)). write_canonical(SorA, Term) :- set_bip_name(write_canonical, 2), '$call_c'('Pl_Write_Canonical_2'(SorA, Term)). display(Term) :- set_bip_name(display, 1), '$call_c'('Pl_Display_1'(Term)). display(SorA, Term) :- set_bip_name(display, 2), '$call_c'('Pl_Display_2'(SorA, Term)). % see file print.pl for the definition of print/1-2 % option mask in sys_var[0]: (see write_supp.h) % % b6 b5 b4 b3 b2 b1 b0 % 0/1 0/1 0/1 0/1 0/1 0/1 0/1 % var_names portrayed space_args namevars numbervars ignore_ops quoted % 0=false 0=false 0=false 0=false 0=false 0=false 0=false % 1=true 1=true 1=true 1=true 1=true 1=true 1=true % % max_depth in sys_var[1] % priority in sys_var[2] write_term(Term, Options) :- set_bip_name(write_term, 2), '$set_write_defaults', '$get_write_options'(Options), '$call_c'('Pl_Write_Term_1'(Term)), fail. write_term(_, _). write_term(SorA, Term, Options) :- set_bip_name(write_term, 3), '$set_write_defaults', '$get_write_options'(Options), '$call_c'('Pl_Write_Term_2'(SorA, Term)), fail. write_term(_, _, _). '$set_write_defaults' :- '$sys_var_write'(0, 0), % default mask '$sys_var_write'(1, -1), '$sys_var_write'(2, 1200), '$sys_var_write'(3, 0). '$get_write_options'(Options) :- '$check_list'(Options), '$get_write_options1'(Options), ( '$sys_var_get_bit'(0, 6, 1) -> % variable_names ==> namevars '$sys_var_set_bit'(0, 3) ; true ). '$get_write_options1'([]). '$get_write_options1'([X|Options]) :- '$get_write_options2'(X), !, '$get_write_options1'(Options). '$get_write_options2'(X) :- var(X), '$pl_err_instantiation'. '$get_write_options2'(quoted(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 0) ; X = true, '$sys_var_set_bit'(0, 0) ). '$get_write_options2'(ignore_ops(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 1) ; X = true, '$sys_var_set_bit'(0, 1) ). '$get_write_options2'(numbervars(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 2) ; X = true, '$sys_var_set_bit'(0, 2) ). '$get_write_options2'(namevars(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 3) ; X = true, '$sys_var_set_bit'(0, 3) ). '$get_write_options2'('$above'(X)) :- % "above" choice-point for numbervars/namevars '$check_nonvar'(X), integer(X), '$sys_var_write'(3, X). '$get_write_options2'(space_args(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 4) ; X = true, '$sys_var_set_bit'(0, 4) ). '$get_write_options2'(portrayed(X)) :- '$check_nonvar'(X), ( X = false, '$sys_var_reset_bit'(0, 5) ; X = true, '$sys_var_set_bit'(0, 5) ). '$get_write_options2'(variable_names(VarNames)) :- '$check_nonvar'(VarNames), '$sys_var_set_bit'(0, 6), '$name_variables'(VarNames). '$get_write_options2'(max_depth(X)) :- '$check_nonvar'(X), integer(X), '$sys_var_write'(1, X). '$get_write_options2'(priority(X)) :- '$check_nonvar'(X), integer(X), '$sys_var_write'(2, X). '$get_write_options2'(X) :- '$pl_err_domain'(write_option, X). '$name_variables'(X) :- var(X), !, '$pl_err_instantiation'. '$name_variables'([]). '$name_variables'([Name = Var|VarNames]) :- '$check_nonvar'(Name), atom(Name), % ('$is_valid_var_name'(Name), Var = '$VARNAME'(Name), ! ; true), % to check the validity of the atom (Var = '$VARNAME'(Name), ! ; true), '$name_variables'(VarNames). '$is_valid_var_name'(Name) :- '$call_c_test'('Pl_Is_Valid_Var_Name_1'(Name)). nl :- set_bip_name(nl, 0), '$call_c'('Pl_Nl_0'). nl(SorA) :- set_bip_name(nl, 1), '$call_c'('Pl_Nl_1'(SorA)). �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/sockets_c.c����������������������������������������������������������������0000644�0001750�0001750�00000042014�13021324543�015421� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : sockets_c.c * * Descr.: sockets management - C part * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include "gp_config.h" #include <stdio.h> #include <string.h> #include <errno.h> #include <sys/types.h> #ifndef _WIN32 #include <unistd.h> #include <sys/socket.h> #else #include <io.h> #include <fcntl.h> #include <winsock2.h> #define SO_OPENTYPE 0x7008 #define SO_SYNCHRONOUS_NONALERT 0x20 #endif /* old versions of CYGWIN do not support AF_UNIX - modify next line */ #if defined(__unix__) || defined(__CYGWIN__) #define SUPPORT_AF_UNIX #endif #ifdef SUPPORT_AF_UNIX #include <sys/un.h> #endif #ifndef _WIN32 #include <netinet/in.h> #include <arpa/inet.h> #include <netdb.h> #endif #define OBJ_INIT Socket_Initializer #include "engine_pl.h" #include "bips_pl.h" /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef SUPPORT_AF_UNIX static int atom_AF_UNIX; #endif static int atom_AF_INET; /*---------------------------------* * Function Prototypes * *---------------------------------*/ static Bool Create_Socket_Streams(int sock, char *stream_name, int *stm_in, int *stm_out); /*-------------------------------------------------------------------------* * SOCKET_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Socket_Initializer(void) { #ifdef _WIN32 WORD versReqstd = MAKEWORD( 2, 2); /* Current Winsock 2 DLL's */ WSADATA wsaData; int err; int optionValue = SO_SYNCHRONOUS_NONALERT; #endif #ifdef SUPPORT_AF_UNIX atom_AF_UNIX = Pl_Create_Atom("AF_UNIX"); #endif atom_AF_INET = Pl_Create_Atom("AF_INET"); #ifdef _WIN32 if ((err = WSAStartup(versReqstd, &wsaData)) != 0 || wsaData.wVersion != versReqstd) { Pl_Stream_Printf(pl_stm_tbl[pl_stm_top_level_output], "warning: cannot find a usable WinSock DLL\n"); if (err == 0) WSACleanup(); } /* Allow Windows sockets to act as filehandles */ if (setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, (char *)&optionValue, sizeof(optionValue)) == SOCKET_ERROR) Pl_Os_Error(-1); #endif } /*-------------------------------------------------------------------------* * PL_SOCKET_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Socket_2(WamWord domain_word, WamWord socket_word) { int domain; int opt; #ifdef _WIN32 SOCKET sock; int proto = IPPROTO_TCP; #else int sock; int proto = 0; #endif domain = Pl_Rd_Atom_Check(domain_word); if ( #ifdef SUPPORT_AF_UNIX domain != atom_AF_UNIX && #endif domain != atom_AF_INET) Pl_Err_Domain(pl_domain_socket_domain, domain_word); Pl_Check_For_Un_Variable(socket_word); #ifdef SUPPORT_AF_UNIX if (domain == atom_AF_UNIX) sock = socket(AF_UNIX, SOCK_STREAM, proto); else #endif sock = socket(AF_INET, SOCK_STREAM, proto); #ifdef _WIN32 Os_Test_Error(sock); /* NB: on error returns INVALID_SOCKET == -1 */ /* * Windows (by default) causes sockets to be inherited * by child processes. Turn this off. */ SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0); #else Os_Test_Error(sock); #endif /* * disable bind address checking (port can be reused) * else the TIME_WAIT prevent bindings to this address:port * for 2xMSL seconds (delay). */ opt = 1; Os_Test_Error(setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (const void *) &opt, sizeof(opt))); return Pl_Get_Integer(sock, socket_word); } /*-------------------------------------------------------------------------* * PL_SOCKET_CLOSE_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Socket_Close_1(WamWord socket_word) { #ifndef _WIN32 int sock; #else SOCKET sock; #endif sock = Pl_Rd_Integer_Check(socket_word); if (sock < 2) { errno = EBADF; Os_Test_Error(-1); } else #ifndef _WIN32 Os_Test_Error(close(sock)); #else Os_Test_Error(closesocket(sock)); #endif return TRUE; } /*-------------------------------------------------------------------------* * PL_SOCKET_BIND_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Socket_Bind_2(WamWord socket_word, WamWord address_word) { WamWord word, tag_mask; WamWord *stc_adr; int dom; int sock; int port; socklen_t l; #ifdef SUPPORT_AF_UNIX char *path_name; struct sockaddr_un adr_un; #endif struct sockaddr_in adr_in; static int atom_host_name = -1; /* not created in an init since */ /* establishes a connection */ sock = Pl_Rd_Integer_Check(socket_word); DEREF(address_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_STC_MASK) { err_domain: Pl_Err_Domain(pl_domain_socket_address, word); } stc_adr = UnTag_STC(word); #ifdef SUPPORT_AF_UNIX if (Functor_Arity(atom_AF_UNIX, 1) == Functor_And_Arity(stc_adr)) dom = AF_UNIX; else #endif if (Functor_Arity(atom_AF_INET, 2) == Functor_And_Arity(stc_adr)) dom = AF_INET; else goto err_domain; #ifdef SUPPORT_AF_UNIX if (dom == AF_UNIX) { path_name = Pl_Rd_String_Check(Arg(stc_adr, 0)); if ((path_name = Pl_M_Absolute_Path_Name(path_name)) == NULL) Pl_Err_Domain(pl_domain_os_path, Arg(stc_adr, 0)); adr_un.sun_family = AF_UNIX; strcpy(adr_un.sun_path, path_name); unlink(path_name); Os_Test_Error(bind(sock, (struct sockaddr *) &adr_un, sizeof(adr_un))); return TRUE; } #endif /* case AF_INET */ DEREF(Arg(stc_adr, 0), word, tag_mask); if (tag_mask == TAG_REF_MASK) { if (atom_host_name < 0) atom_host_name = Pl_Create_Allocate_Atom(Pl_M_Host_Name_From_Name(NULL)); Pl_Get_Atom(atom_host_name, word); } else Pl_Rd_Atom_Check(word); /* only to test the type */ port = 0; DEREF(Arg(stc_adr, 1), word, tag_mask); if (tag_mask != TAG_REF_MASK) port = Pl_Rd_Integer_Check(word); adr_in.sin_port = htons((unsigned short) port); adr_in.sin_family = AF_INET; adr_in.sin_addr.s_addr = INADDR_ANY; Os_Test_Error(bind(sock, (struct sockaddr *) &adr_in, sizeof(adr_in))); if (tag_mask == TAG_INT_MASK) return TRUE; l = sizeof(adr_in); Os_Test_Error(getsockname(sock, (struct sockaddr *) &adr_in, &l)); port = ntohs(adr_in.sin_port); return Pl_Get_Integer(port, word); } /*-------------------------------------------------------------------------* * PL_SOCKET_CONNECT_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Socket_Connect_4(WamWord socket_word, WamWord address_word, WamWord stm_in_word, WamWord stm_out_word) { WamWord word, tag_mask; WamWord *stc_adr; int dom; int sock; int port; char *host_name; #ifdef SUPPORT_AF_UNIX char *path_name; struct sockaddr_un adr_un; #endif struct sockaddr_in adr_in; struct hostent *host_entry; int stm_in, stm_out; char stream_name[256]; sock = Pl_Rd_Integer_Check(socket_word); DEREF(address_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_STC_MASK) { err_domain: Pl_Err_Domain(pl_domain_socket_address, word); } stc_adr = UnTag_STC(word); #ifdef SUPPORT_AF_UNIX if (Functor_Arity(atom_AF_UNIX, 1) == Functor_And_Arity(stc_adr)) dom = AF_UNIX; else #endif if (Functor_Arity(atom_AF_INET, 2) == Functor_And_Arity(stc_adr)) dom = AF_INET; else goto err_domain; #ifdef SUPPORT_AF_UNIX if (dom == AF_UNIX) { path_name = Pl_Rd_String_Check(Arg(stc_adr, 0)); if ((path_name = Pl_M_Absolute_Path_Name(path_name)) == NULL) Pl_Err_Domain(pl_domain_os_path, Arg(stc_adr, 0)); adr_un.sun_family = AF_UNIX; strcpy(adr_un.sun_path, path_name); Os_Test_Error(connect(sock, (struct sockaddr *) &adr_un, sizeof(adr_un))); sprintf(stream_name, "socket_stream(connect('AF_UNIX'('%s')),%d)", path_name, sock); #ifdef _WIN32 /* Check for in-progress connection */ Os_Test_Error( send(sock, "", 0, 0) ); #endif goto create_streams; } #endif /* case AF_INET */ host_name = Pl_Rd_String_Check(Arg(stc_adr, 0)); port = Pl_Rd_Integer_Check(Arg(stc_adr, 1)); host_entry = gethostbyname(host_name); if (host_entry == NULL) return FALSE; adr_in.sin_family = AF_INET; adr_in.sin_port = htons((unsigned short) port); memcpy(&adr_in.sin_addr, host_entry->h_addr_list[0], host_entry->h_length); Os_Test_Error(connect(sock, (struct sockaddr *) &adr_in, sizeof(adr_in))); sprintf(stream_name, "socket_stream(connect('AF_INET'('%s',%d)),%d)", host_name, port, sock); #ifdef SUPPORT_AF_UNIX create_streams: #endif if (!Create_Socket_Streams(sock, stream_name, &stm_in, &stm_out)) return FALSE; Pl_Get_Integer(stm_in, stm_in_word); Pl_Get_Integer(stm_out, stm_out_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_SOCKET_LISTEN_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Socket_Listen_2(WamWord socket_word, WamWord length_word) { int sock; int length; sock = Pl_Rd_Integer_Check(socket_word); length = Pl_Rd_Integer_Check(length_word); Os_Test_Error(listen(sock, length)); return TRUE; } /*-------------------------------------------------------------------------* * PL_SOCKET_ACCEPT_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Socket_Accept_4(WamWord socket_word, WamWord client_word, WamWord stm_in_word, WamWord stm_out_word) { int sock, cli_sock; socklen_t l; struct sockaddr_in adr_in; int stm_in, stm_out; char *cli_ip_adr = "AF_UNIX"; char stream_name[256]; l = sizeof(adr_in); sock = Pl_Rd_Integer_Check(socket_word); cli_sock = accept(sock, (struct sockaddr *) &adr_in, &l); Os_Test_Error(cli_sock); if (adr_in.sin_family == AF_INET) { cli_ip_adr = inet_ntoa(adr_in.sin_addr); if (cli_ip_adr == NULL) return FALSE; Pl_Get_Atom(Pl_Create_Allocate_Atom(cli_ip_adr), client_word); } sprintf(stream_name, "socket_stream(accept('%s'),%d)", cli_ip_adr, cli_sock); if (!Create_Socket_Streams(cli_sock, stream_name, &stm_in, &stm_out)) return FALSE; Pl_Get_Integer(stm_in, stm_in_word); Pl_Get_Integer(stm_out, stm_out_word); return TRUE; } /*-------------------------------------------------------------------------* * PL_ASSOC_SOCKET_STREAMS_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Assoc_Socket_Streams_3(WamWord socket_word, WamWord stm_in_word, WamWord stm_out_word) { int stm_in, stm_out; char stream_name[256]; int sock = Pl_Rd_Integer_Check(socket_word); sprintf(stream_name, "socket_stream(assoc(%d))", sock); if (!Create_Socket_Streams(sock, stream_name, &stm_in, &stm_out)) return FALSE; Pl_Get_Integer(stm_in, stm_in_word); Pl_Get_Integer(stm_out, stm_out_word); return TRUE; } /*-------------------------------------------------------------------------* * CREATE_SOCKET_STREAMS * * * *-------------------------------------------------------------------------*/ static Bool Create_Socket_Streams(int sock, char *stream_name, int *stm_in, int *stm_out) { int fd; FILE *f_in, *f_out; int atom; int stm; #ifdef _WIN32 int r; Os_Test_Error((fd = _open_osfhandle(sock, _O_BINARY | _O_RDWR | _O_BINARY))); Os_Test_Error((r = dup(fd))); Os_Test_Error_Null((f_out = fdopen(fd, "w"))); Os_Test_Error_Null((f_in = fdopen(r, "r"))); #else Os_Test_Error((fd = dup(sock))); Os_Test_Error_Null((f_in = fdopen(sock, "rt"))); Os_Test_Error_Null((f_out = fdopen(fd, "wt"))); #endif atom = Pl_Create_Allocate_Atom(stream_name); stm = Pl_Add_Stream_For_Stdio_Desc(f_in, atom, STREAM_MODE_READ, TRUE); pl_stm_tbl[stm]->prop.eof_action = STREAM_EOF_ACTION_RESET; pl_stm_tbl[stm]->prop.other = 4; *stm_in = stm; stm = Pl_Add_Stream_For_Stdio_Desc(f_out, atom, STREAM_MODE_WRITE, TRUE); pl_stm_tbl[stm]->prop.other = 4; *stm_out = stm; return TRUE; } /*-------------------------------------------------------------------------* * PL_HOSTNAME_ADDRESS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Hostname_Address_2(WamWord host_name_word, WamWord host_address_word) { WamWord word, tag_mask; char *host_name; char *host_address; struct hostent *host_entry; struct in_addr iadr; DEREF(host_name_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) { host_address = Pl_Rd_String_Check(host_address_word); host_name = Pl_M_Host_Name_From_Adr(host_address); return host_name && Pl_Un_String_Check(host_name, host_name_word); } host_name = Pl_Rd_String_Check(word); Pl_Check_For_Un_Atom(host_address_word); host_entry = gethostbyname(host_name); if (host_entry == NULL) return FALSE; memcpy(&iadr.s_addr, host_entry->h_addr_list[0], host_entry->h_length); host_address = inet_ntoa(iadr); return Pl_Un_String_Check(host_address, host_address_word); } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/c_supp.h�������������������������������������������������������������������0000644�0001750�0001750�00000022353�13021324543�014746� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : c_supp.h * * Descr.: C interface support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ /*---------------------------------* * Function Prototypes * *---------------------------------*/ PlLong Pl_Rd_Integer_Check(WamWord start_word); PlLong Pl_Rd_Integer(WamWord start_word); PlLong Pl_Rd_Positive_Check(WamWord start_word); PlLong Pl_Rd_Positive(WamWord start_word); double Pl_Rd_Float_Check(WamWord start_word); double Pl_Rd_Float(WamWord start_word); double Pl_Rd_Number_Check(WamWord start_word); double Pl_Rd_Number(WamWord start_word); int Pl_Rd_Atom_Check(WamWord start_word); int Pl_Rd_Atom(WamWord start_word); int Pl_Rd_Boolean_Check(WamWord start_word); int Pl_Rd_Boolean(WamWord start_word); int Pl_Rd_Char_Check(WamWord start_word); int Pl_Rd_Char(WamWord start_word); int Pl_Rd_In_Char_Check(WamWord start_word); int Pl_Rd_In_Char(WamWord start_word); int Pl_Rd_Code_Check(WamWord start_word); int Pl_Rd_Code(WamWord start_word); int Pl_Rd_In_Code_Check(WamWord start_word); int Pl_Rd_In_Code(WamWord start_word); int Pl_Rd_Byte_Check(WamWord start_word); int Pl_Rd_Byte(WamWord start_word); int Pl_Rd_In_Byte_Check(WamWord start_word); int Pl_Rd_In_Byte(WamWord start_word); char *Pl_Rd_String_Check(WamWord start_word); char *Pl_Rd_String(WamWord start_word); char *Pl_Rd_Chars_Check(WamWord start_word); char *Pl_Rd_Chars(WamWord start_word); char *Pl_Rd_Codes_Check(WamWord start_word); char *Pl_Rd_Codes(WamWord start_word); int Pl_Rd_Chars_Str_Check(WamWord start_word, char *str); int Pl_Rd_Chars_Str(WamWord start_word, char *str); int Pl_Rd_Codes_Str_Check(WamWord start_word, char *str); int Pl_Rd_Codes_Str(WamWord start_word, char *str); WamWord *Pl_Rd_List_Check(WamWord start_word); WamWord *Pl_Rd_List(WamWord start_word); int Pl_Rd_Proper_List_Check(WamWord start_word, WamWord *arg); int Pl_Rd_Proper_List_Check2(WamWord start_word, WamWord *arg, WamWord (*elt_fct)(WamWord start_word)); int Pl_Rd_Proper_List(WamWord start_word, WamWord *arg); WamWord *Pl_Rd_Compound_Check(WamWord start_word, int *func, int *arity); WamWord *Pl_Rd_Compound(WamWord start_word, int *func, int *arity); WamWord *Pl_Rd_Callable_Check(WamWord start_word, int *func, int *arity); WamWord *Pl_Rd_Callable(WamWord start_word, int *func, int *arity); void Pl_Check_For_Un_Integer(WamWord start_word); void Pl_Check_For_Un_Positive(WamWord start_word); void Pl_Check_For_Un_Float(WamWord start_word); void Pl_Check_For_Un_Number(WamWord start_word); void Pl_Check_For_Un_Atom(WamWord start_word); void Pl_Check_For_Un_Boolean(WamWord start_word); void Pl_Check_For_Un_Char(WamWord start_word); void Pl_Check_For_Un_In_Char(WamWord start_word); void Pl_Check_For_Un_Code(WamWord start_word); void Pl_Check_For_Un_In_Code(WamWord start_word); void Pl_Check_For_Un_Byte(WamWord start_word); void Pl_Check_For_Un_In_Byte(WamWord start_word); void Pl_Check_For_Un_String(WamWord start_word); void Pl_Check_For_Un_Chars(WamWord start_word); void Pl_Check_For_Un_Codes(WamWord start_word); void Pl_Check_For_Un_List(WamWord start_word); void Pl_Check_For_Un_List2(WamWord start_word, void (*elt_fct)(WamWord start_word)); void Pl_Check_For_Un_Compound(WamWord start_word); void Pl_Check_For_Un_Callable(WamWord start_word); void Pl_Check_For_Un_Variable(WamWord start_word); Bool Pl_Un_Integer_Check(PlLong value, WamWord start_word); Bool Pl_Un_Integer(PlLong value, WamWord start_word); Bool Pl_Un_Positive_Check(PlLong value, WamWord start_word); Bool Pl_Un_Positive(PlLong value, WamWord start_word); Bool Pl_Un_Float_Check(double value, WamWord start_word); Bool Pl_Un_Float(double value, WamWord start_word); Bool Pl_Un_Number_Check(double value, WamWord start_word); Bool Pl_Un_Number(double value, WamWord start_word); Bool Pl_Un_Atom_Check(int value, WamWord start_word); Bool Pl_Un_Atom(int value, WamWord start_word); Bool Pl_Un_Boolean_Check(int value, WamWord start_word); Bool Pl_Un_Boolean(int value, WamWord start_word); Bool Pl_Un_Char_Check(int value, WamWord start_word); Bool Pl_Un_Char(int value, WamWord start_word); Bool Pl_Un_In_Char_Check(int value, WamWord start_word); Bool Pl_Un_In_Char(int value, WamWord start_word); Bool Pl_Un_Code_Check(int value, WamWord start_word); Bool Pl_Un_Code(int value, WamWord start_word); Bool Pl_Un_In_Code_Check(int value, WamWord start_word); Bool Pl_Un_In_Code(int value, WamWord start_word); Bool Pl_Un_Byte_Check(int value, WamWord start_word); Bool Pl_Un_Byte(int value, WamWord start_word); Bool Pl_Un_In_Byte_Check(int value, WamWord start_word); Bool Pl_Un_In_Byte(int value, WamWord start_word); Bool Pl_Un_String_Check(char *value, WamWord start_word); Bool Pl_Un_String(char *value, WamWord start_word); Bool Pl_Un_Chars_Check(char *value, WamWord start_word); Bool Pl_Un_Chars(char *value, WamWord start_word); Bool Pl_Un_Codes_Check(char *value, WamWord start_word); Bool Pl_Un_Codes(char *value, WamWord start_word); Bool Pl_Un_List_Check(WamWord *arg, WamWord start_word); Bool Pl_Un_List(WamWord *arg, WamWord start_word); Bool Pl_Un_Proper_List_Check(int n, WamWord *arg, WamWord start_word); Bool Pl_Un_Proper_List(int n, WamWord *arg, WamWord start_word); Bool Pl_Un_Compound_Check(int func, int arity, WamWord *arg, WamWord start_word); Bool Pl_Un_Compound(int func, int arity, WamWord *arg, WamWord start_word); Bool Pl_Un_Callable_Check(int func, int arity, WamWord *arg, WamWord start_word); Bool Pl_Un_Callable(int func, int arity, WamWord *arg, WamWord start_word); Bool Pl_Un_Term(WamWord term_word, WamWord start_word); WamWord Pl_Mk_Integer(PlLong value); WamWord Pl_Mk_Positive(PlLong value); WamWord Pl_Mk_Float(double value); WamWord Pl_Mk_Number(double value); WamWord Pl_Mk_Atom(int value); WamWord Pl_Mk_Boolean(int value); WamWord Pl_Mk_Char(int value); WamWord Pl_Mk_In_Char(int value); WamWord Pl_Mk_Code(int value); WamWord Pl_Mk_In_Code(int value); WamWord Pl_Mk_Byte(int value); WamWord Pl_Mk_In_Byte(int value); WamWord Pl_Mk_String(char *value); WamWord Pl_Mk_Chars(char *value); WamWord Pl_Mk_Codes(char *value); WamWord Pl_Mk_List(WamWord *arg); WamWord Pl_Mk_Proper_List(int n, WamWord *arg); WamWord Pl_Mk_Compound(int func, int arity, WamWord *arg); WamWord Pl_Mk_Callable(int func, int arity, WamWord *arg); WamWord Pl_Mk_Variable(void); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/bc_supp.c������������������������������������������������������������������0000644�0001750�0001750�00000130406�13021324543�015102� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : bc_supp.c * * Descr.: byte-code support * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #define OBJ_INIT Byte_Code_Initializer #define BC_SUPP_FILE #include "engine_pl.h" #include "bips_pl.h" #if 0 #define DEBUG #endif /*---------------------------------* * Constants * *---------------------------------*/ #define MAX_OP 100 #define BC_BLOCK_SIZE 1024 #define ERR_UNKNOWN_INSTRUCTION "bc_supp: Unknown WAM instruction: %s" /*---------------------------------* * Type Definitions * *---------------------------------*/ typedef enum { GET_X_VARIABLE, GET_Y_VARIABLE, GET_X_VALUE, GET_Y_VALUE, GET_ATOM, GET_ATOM_BIG, GET_INTEGER, GET_INTEGER_BIG, GET_FLOAT, GET_NIL, GET_LIST, GET_STRUCTURE, PUT_X_VARIABLE, PUT_Y_VARIABLE, PUT_VOID, PUT_X_VALUE, PUT_Y_VALUE, PUT_Y_UNSAFE_VALUE, PUT_ATOM, PUT_ATOM_BIG, PUT_INTEGER, PUT_INTEGER_BIG, PUT_FLOAT, PUT_NIL, PUT_LIST, PUT_STRUCTURE, PUT_META_TERM, MATH_LOAD_X_VALUE, MATH_LOAD_Y_VALUE, UNIFY_X_VARIABLE, UNIFY_Y_VARIABLE, UNIFY_VOID, UNIFY_X_VALUE, UNIFY_Y_VALUE, UNIFY_X_LOCAL_VALUE, UNIFY_Y_LOCAL_VALUE, UNIFY_ATOM, UNIFY_ATOM_BIG, UNIFY_INTEGER, UNIFY_INTEGER_BIG, UNIFY_NIL, UNIFY_LIST, UNIFY_STRUCTURE, ALLOCATE, DEALLOCATE, CALL, CALL_NATIVE, EXECUTE, EXECUTE_NATIVE, PROCEED, FAIL, GET_CURRENT_CHOICE_X, GET_CURRENT_CHOICE_Y, CUT_X, CUT_Y, SOFT_CUT_X, SOFT_CUT_Y } BCCodOp; typedef union { struct { unsigned code_op:8; unsigned i8:8; unsigned i16:16; } t1; struct { unsigned code_op:8; unsigned i24:24; } t2; unsigned word; } BCWord; typedef union { double d; #if WORD_SIZE == 64 uint64_t l; #endif uint32_t u[2]; } C64To32; /*---------------------------------* * Global Variables * *---------------------------------*/ static BCWord op_tbl[MAX_OP]; static int nb_op; static BCWord *bc; static BCWord *bc_sp; static int bc_nb_block; static int atom_dynamic; static int atom_public; static int atom_multifile; static int atom_built_in; static int atom_built_in_fd; static int atom_local; static int atom_fail; static int atom_if; static int atom_soft_if; static int atom_call; static int atom_catch; static int atom_throw; /* for byte-code creation */ static int glob_caller_module; static int glob_caller_func; static int glob_caller_arity; /* for byte-code emulation */ static PredInf *glob_pred; static Bool debug_call; WamCont pl_debug_call_code; /* overwritten by debugger_c.c */ /*---------------------------------* * Function Prototypes * *---------------------------------*/ static int Find_Inst_Code_Op(int inst); static int Compar_Inst_Code_Op(BCWord *w1, BCWord *w2); static int BC_Arg_X_Or_Y(WamWord arg_word, int *op); static int BC_Arg_Func_Arity(WamWord arg_word, int *arity); static int BC_Arg_Module_Func_Arity(WamWord arg_word, int *func, int *arity); static WamCont BC_Emulate_Pred(PredInf *pred); static WamCont BC_Emulate_Pred_Alt(DynCInf *clause, WamWord *w); static WamCont BC_Emulate_Clause(DynCInf *clause); static WamCont BC_Emulate_Byte_Code(BCWord *bc); static void Prep_Debug_Call(int module, int func, int arity, int caller_func, int caller_arity); #define BC_EMULATE_CONT X1_2462635F656D756C6174655F636F6E74 #define CALL_INTERNAL_WITH_CUT X1_2463616C6C5F696E7465726E616C5F776974685F637574 #define CALL_INTERNAL_AND X1_2463616C6C5F696E7465726E616C5F616E64 #define CALL_INTERNAL_OR X1_2463616C6C5F696E7465726E616C5F6F72 #define CALL_INTERNAL_IF X1_2463616C6C5F696E7465726E616C5F6966 #define CALL_INTERNAL_SOFT_IF X1_2463616C6C5F696E7465726E616C5F736F66745F6966 #define CATCH_INTERNAL X1_2463617463685F696E7465726E616C #define THROW_INTERNAL X1_247468726F775F696E7465726E616C Prolog_Prototype(BC_EMULATE_CONT, 0); Prolog_Prototype(CALL_INTERNAL_WITH_CUT, 4); Prolog_Prototype(CALL_INTERNAL_AND, 5); Prolog_Prototype(CALL_INTERNAL_OR, 5); Prolog_Prototype(CALL_INTERNAL_IF, 5); Prolog_Prototype(CALL_INTERNAL_SOFT_IF, 5); Prolog_Prototype(CALL_COMPLEX, 5); Prolog_Prototype(CATCH_INTERNAL, 5); Prolog_Prototype(THROW_INTERNAL, 3); #define BC_Op(w) ((w).t1.code_op) #define BC1_X0(w) ((w).t1.i8) #define BC1_Arity(w) ((w).t1.i16) #define BC2_Arity(w) ((w).t2.i24) #define BC1_XY(w) ((w).t1.i16) #define BC2_XY(w) ((w).t2.i24) #define BC1_Atom(w) ((w).t1.i16) #define BC2_Atom(w) ((w).t2.i24) #define BC1_Int(w) ((w).t1.i16) #define BC2_Int(w) ((w).t2.i24) #define Fit_In_16bits(n) ((PlULong) (n) < (1 << 16)) #define Fit_In_24bits(n) ((PlULong) (n) < (1 << 24)) #define Op_In_Tbl(str, op) BC_Op(*p) = op; BC2_Atom(*p) = Pl_Create_Atom(str); p++ #if WORD_SIZE == 32 #define Compute_Branch_Adr(bc, codep) \ { \ codep = (CodePtr) (bc->word); bc++; \ } #else #define Compute_Branch_Adr(bc, codep) \ { \ cv.u[0] = (unsigned) (bc->word); bc++; \ cv.u[1] = (unsigned) (bc->word); bc++; \ codep = (CodePtr) (cv.l); \ } #endif /*-------------------------------------------------------------------------* * BYTE_CODE_INITIALIZER * * * *-------------------------------------------------------------------------*/ static void Byte_Code_Initializer(void) { BCWord *p = op_tbl; Op_In_Tbl("get_variable", GET_X_VARIABLE); Op_In_Tbl("get_value", GET_X_VALUE); Op_In_Tbl("get_atom", GET_ATOM); Op_In_Tbl("get_integer", GET_INTEGER); Op_In_Tbl("get_float", GET_FLOAT); Op_In_Tbl("get_nil", GET_NIL); Op_In_Tbl("get_list", GET_LIST); Op_In_Tbl("get_structure", GET_STRUCTURE); Op_In_Tbl("put_variable", PUT_X_VARIABLE); Op_In_Tbl("put_void", PUT_VOID); Op_In_Tbl("put_value", PUT_X_VALUE); Op_In_Tbl("put_unsafe_value", PUT_Y_UNSAFE_VALUE - 1); Op_In_Tbl("put_atom", PUT_ATOM); Op_In_Tbl("put_integer", PUT_INTEGER); Op_In_Tbl("put_float", PUT_FLOAT); Op_In_Tbl("put_nil", PUT_NIL); Op_In_Tbl("put_list", PUT_LIST); Op_In_Tbl("put_structure", PUT_STRUCTURE); Op_In_Tbl("put_meta_term", PUT_META_TERM); Op_In_Tbl("math_load_value", MATH_LOAD_X_VALUE); Op_In_Tbl("unify_variable", UNIFY_X_VARIABLE); Op_In_Tbl("unify_void", UNIFY_VOID); Op_In_Tbl("unify_value", UNIFY_X_VALUE); Op_In_Tbl("unify_local_value", UNIFY_X_LOCAL_VALUE); Op_In_Tbl("unify_atom", UNIFY_ATOM); Op_In_Tbl("unify_integer", UNIFY_INTEGER); Op_In_Tbl("unify_nil", UNIFY_NIL); Op_In_Tbl("unify_list", UNIFY_LIST); Op_In_Tbl("unify_structure", UNIFY_STRUCTURE); Op_In_Tbl("allocate", ALLOCATE); Op_In_Tbl("deallocate", DEALLOCATE); Op_In_Tbl("call", CALL); Op_In_Tbl("execute", EXECUTE); Op_In_Tbl("proceed", PROCEED); Op_In_Tbl("fail", FAIL); Op_In_Tbl("get_current_choice", GET_CURRENT_CHOICE_X); Op_In_Tbl("cut", CUT_X); Op_In_Tbl("soft_cut", SOFT_CUT_X); nb_op = p - op_tbl; qsort(op_tbl, nb_op, sizeof(op_tbl[0]), (int (*)(const void *, const void *)) Compar_Inst_Code_Op); bc_nb_block = 1; bc = (BCWord *) Malloc(bc_nb_block * BC_BLOCK_SIZE * sizeof(BCWord)); atom_dynamic = Pl_Create_Atom("dynamic"); atom_public = Pl_Create_Atom("public"); atom_multifile = Pl_Create_Atom("multifile"); atom_built_in = Pl_Create_Atom("built_in"); atom_built_in_fd = Pl_Create_Atom("built_in_fd"); atom_local = Pl_Create_Atom("local"); atom_fail = Pl_Create_Atom("fail"); atom_if = Pl_Create_Atom("->"); atom_soft_if = Pl_Create_Atom("*->"); atom_call = Pl_Create_Atom("call"); atom_catch = Pl_Create_Atom("catch"); atom_throw = Pl_Create_Atom("throw"); } /*-------------------------------------------------------------------------* * Part I. Byte-Code creation. * * * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * FIND_INST_CODE_OP * * * *-------------------------------------------------------------------------*/ static int Find_Inst_Code_Op(int inst) { BCWord *p; BCWord w; BC2_Atom(w) = inst; p = (BCWord *) bsearch(&w, op_tbl, nb_op, sizeof(op_tbl[0]), (int (*)(const void *, const void *)) Compar_Inst_Code_Op); if (p == NULL) Pl_Fatal_Error(ERR_UNKNOWN_INSTRUCTION, pl_atom_tbl[inst].name); return BC_Op(*p); } /*-------------------------------------------------------------------------* * COMPAR_INST_CODE_OP * * * *-------------------------------------------------------------------------*/ static int Compar_Inst_Code_Op(BCWord *p1, BCWord *p2) { return BC2_Atom(*p1) - BC2_Atom(*p2); } /*-------------------------------------------------------------------------* * PL_BC_START_PRED_9 * * * *-------------------------------------------------------------------------*/ void Pl_BC_Start_Pred_9(WamWord module_word, WamWord func_word, WamWord arity_word, WamWord pl_file_word, WamWord pl_line_word, WamWord sta_dyn_word, WamWord pub_priv_word, WamWord mono_multi_word, WamWord us_blp_bfd_word) { int module, func, arity; int pl_file, pl_line; int prop = 0; int atom; int multi = 0; PredInf *pred; module = Pl_Rd_Atom_Check(module_word); func = Pl_Rd_Atom_Check(func_word); arity = Pl_Rd_Integer_Check(arity_word); pl_file = Pl_Rd_Atom_Check(pl_file_word); pl_line = Pl_Rd_Integer_Check(pl_line_word); if (Pl_Rd_Atom_Check(sta_dyn_word) == atom_dynamic) prop = MASK_PRED_DYNAMIC | MASK_PRED_PUBLIC; else if (Pl_Rd_Atom_Check(pub_priv_word) == atom_public) prop = MASK_PRED_PUBLIC; if (Pl_Rd_Atom_Check(mono_multi_word) == atom_multifile) { prop |= MASK_PRED_MULTIFILE; multi = 1; } atom = Pl_Rd_Atom_Check(us_blp_bfd_word); if (atom == atom_built_in) prop |= MASK_PRED_BUILTIN; else if (atom == atom_built_in_fd) prop |= MASK_PRED_BUILTIN_FD; else if (atom != atom_local) /* an exported predicate (in case of module) - works for user, local, exported */ prop |= MASK_PRED_EXPORTED; pred = Pl_Update_Dynamic_Pred(module, func, arity, 0, (multi) ? pl_file : -1); if (pred == NULL) pred = Pl_Create_Pred(module, func, arity, pl_file, pl_line, prop, NULL); else { if (multi) pred->prop |= prop; else { pred->pl_file = pl_file; pred->pl_line = pl_line; pred->prop = prop; } } glob_caller_module = module; #if 1 glob_caller_func = Pl_Pred_Without_Aux(func, arity, &glob_caller_arity); #else glob_caller_func = func; glob_caller_arity = arity; #endif #ifdef DEBUG DBGPRINTF("BC start %s/%d\n", pl_atom_tbl[func].name, arity); #endif } /*-------------------------------------------------------------------------* * PL_BC_START_EMIT_0 * * * *-------------------------------------------------------------------------*/ void Pl_BC_Start_Emit_0(void) { bc_sp = bc; } /*-------------------------------------------------------------------------* * PL_BC_STOP_EMIT_0 * * * *-------------------------------------------------------------------------*/ void Pl_BC_Stop_Emit_0(void) { int i; pl_byte_len = bc_sp - bc; #ifdef DEBUG DBGPRINTF("byte-code size:%d\n", pl_byte_len); #endif pl_byte_code = (unsigned *) Malloc(pl_byte_len * sizeof(BCWord)); for (i = 0; i < pl_byte_len; i++) pl_byte_code[i] = bc[i].word; } #define ASSEMBLE_INST(bc_sp, op, nb_word, w, w1, w2, w3) \ BC_Op(w) = op; \ *bc_sp++ = w; \ if (nb_word >= 2) \ { \ bc_sp->word = w1; \ bc_sp++; \ \ if (nb_word >= 3) \ { \ bc_sp->word = w2; \ bc_sp++; \ if (nb_word >= 4) \ { \ bc_sp->word = w3; \ bc_sp++; \ } \ } \ } /*-------------------------------------------------------------------------* * PL_BC_EMIT_INST_1 * * * *-------------------------------------------------------------------------*/ void Pl_BC_Emit_Inst_1(WamWord inst_word) { int module, func, arity; WamWord *arg_adr; int op; int size_bc; BCWord w; /* code-op word */ unsigned w1, w2, w3; /* additional words */ PlLong l; int nb_word; C64To32 cv; PredInf *pred; arg_adr = Pl_Rd_Callable_Check(inst_word, &func, &arity); op = Find_Inst_Code_Op(func); size_bc = bc_sp - bc; if (size_bc + 3 >= bc_nb_block * BC_BLOCK_SIZE) { bc_nb_block++; bc = (BCWord *) Realloc((char *) bc, bc_nb_block * BC_BLOCK_SIZE * sizeof(BCWord)); bc_sp = bc + size_bc; } w.word = 0; nb_word = 1; switch (op) { case GET_X_VARIABLE: case GET_X_VALUE: case PUT_X_VARIABLE: case PUT_X_VALUE: case PUT_Y_UNSAFE_VALUE - 1: case MATH_LOAD_X_VALUE: BC1_XY(w) = BC_Arg_X_Or_Y(*arg_adr++, &op); BC1_X0(w) = Pl_Rd_Integer(*arg_adr); break; case GET_ATOM: case PUT_ATOM: w1 = Pl_Rd_Atom(*arg_adr++); if (Fit_In_16bits(w1)) BC1_Atom(w) = w1; else { op++; nb_word = 2; } BC1_X0(w) = Pl_Rd_Integer(*arg_adr); break; case GET_INTEGER: case PUT_INTEGER: l = Pl_Rd_Integer(*arg_adr++); if (Fit_In_16bits(l)) BC1_Atom(w) = l; else { op++; #if WORD_SIZE == 32 w1 = l; nb_word = 2; #else cv.l = l; w1 = cv.u[0]; w2 = cv.u[1]; nb_word = 3; #endif } BC1_X0(w) = Pl_Rd_Integer(*arg_adr); break; case GET_FLOAT: case PUT_FLOAT: nb_word = 3; cv.d = Pl_Rd_Float(*arg_adr++); BC1_X0(w) = Pl_Rd_Integer(*arg_adr); w1 = cv.u[0]; w2 = cv.u[1]; break; case GET_NIL: case GET_LIST: case PUT_NIL: case PUT_LIST: BC1_X0(w) = Pl_Rd_Integer(*arg_adr); break; case GET_STRUCTURE: case PUT_STRUCTURE: nb_word = 2; w1 = BC_Arg_Func_Arity(*arg_adr++, &arity); BC1_Arity(w) = arity; BC1_X0(w) = Pl_Rd_Integer(*arg_adr); break; case PUT_META_TERM: nb_word = 2; w1 = Pl_Rd_Atom(*arg_adr++); BC1_X0(w) = Pl_Rd_Integer(*arg_adr++); BC1_XY(w) = Pl_Rd_Integer(*arg_adr); break; case PUT_VOID: BC1_X0(w) = Pl_Rd_Integer(*arg_adr); break; case UNIFY_X_VARIABLE: case UNIFY_X_VALUE: case UNIFY_X_LOCAL_VALUE: case GET_CURRENT_CHOICE_X: case CUT_X: case SOFT_CUT_X: BC2_XY(w) = BC_Arg_X_Or_Y(*arg_adr, &op); break; case UNIFY_ATOM: w1 = Pl_Rd_Atom(*arg_adr); if (Fit_In_24bits(w1)) BC2_Atom(w) = w1; else { op++; nb_word = 2; } break; case UNIFY_INTEGER: l = Pl_Rd_Integer(*arg_adr++); if (Fit_In_24bits(l)) BC2_Int(w) = l; else { op++; #if WORD_SIZE == 32 w1 = l; nb_word = 2; #else cv.l = l; w1 = cv.u[0]; w2 = cv.u[1]; nb_word = 3; #endif } break; case UNIFY_STRUCTURE: w1 = BC_Arg_Func_Arity(*arg_adr++, (int *) &arity); BC2_Arity(w) = arity; nb_word = 2; break; case UNIFY_VOID: case ALLOCATE: BC2_Int(w) = Pl_Rd_Integer(*arg_adr); break; case CALL: case EXECUTE: module = BC_Arg_Module_Func_Arity(*arg_adr++, &func, &arity); BC2_Atom(w) = (module == -1) ? glob_caller_module : module; w1 = (unsigned) Functor_Arity(func, arity); pred = Pl_Lookup_Pred_Visible(module, func, arity); if (pred && (pred->prop & MASK_PRED_NATIVE_CODE)) { op++; /* switch to _NATIVE codep */ #if WORD_SIZE == 32 nb_word = 3; w2 = (unsigned) (pred->codep); w3 = 0; /* to avoid MSVC warning */ #else nb_word = 4; cv.l = (uint64_t) (pred->codep); w2 = cv.u[0]; w3 = cv.u[1]; #endif } else { nb_word = 3; w2 = (unsigned) Functor_Arity(glob_caller_func, glob_caller_arity); } break; } ASSEMBLE_INST(bc_sp, op, nb_word, w, w1, w2, w3); #ifdef DEBUG DBGPRINTF(" op: %3d bc: %10.10x ", op, w.word); if (nb_word >= 2) DBGPRINTF("%10.10x ", w1); else DBGPRINTF(" "); if (nb_word >= 3) DBGPRINTF("%10.10x ", w2); else DBGPRINTF(" "); if (nb_word >= 4) DBGPRINTF("%10.10x ", w3); else DBGPRINTF(" "); Pl_Write(inst_word); DBGPRINTF("\n"); #endif } /*-------------------------------------------------------------------------* * BC_EMIT_INST_EXECUTE_NATIVE * * * * This function is called for dynamic or multifile predicate. * * Each clause has been compiled to native code (aux pred). * * We here create a call to this clause. * * This function is called between Pl_BC_Start_Emit_0 and Pl_BC_Stop_Emit_0* * The buffer always bc has enough room for our 3 or 4 words. * *-------------------------------------------------------------------------*/ static void BC_Emit_Inst_Execute_Native(int module, int func, int arity, CodePtr codep) { BCWord w; /* code-op word */ unsigned w1, w2, w3; /* additional words */ int nb_word; #if WORD_SIZE == 64 C64To32 cv; #endif BC2_Atom(w) = (module == -1) ? pl_atom_user : module; w1 = (unsigned) Functor_Arity(func, arity); #if WORD_SIZE == 32 nb_word = 3; w2 = (unsigned) codep; w3 = 0; /* to avoid MSVC warning */ #else nb_word = 4; cv.l = (uint64_t) codep; w2 = cv.u[0]; w3 = cv.u[1]; #endif ASSEMBLE_INST(bc_sp, EXECUTE_NATIVE, nb_word, w, w1, w2, w3); } /*-------------------------------------------------------------------------* * PL_EMIT_BC_EXECUTE_WRAPPER * * * * This function is called by the compiled code for dynamic or multifile * * predicate. Each clause has been compiled to native code (aux pred). * * We here create a call to this clause. * *-------------------------------------------------------------------------*/ void Pl_Emit_BC_Execute_Wrapper(int module, int func, int arity, CodePtr codep) { Pl_BC_Start_Emit_0(); BC_Emit_Inst_Execute_Native(module, func, arity, codep); Pl_BC_Stop_Emit_0(); } /*-------------------------------------------------------------------------* * BC_ARG_X_OR_Y * * * *-------------------------------------------------------------------------*/ static int BC_Arg_X_Or_Y(WamWord arg_word, int *op) { WamWord word, tag_mask; WamWord *adr; DEREF(arg_word, word, tag_mask); adr = UnTag_STC(word); if (Functor(adr) != ATOM_CHAR('x')) (*op)++; /* +1 for op when Y is involved */ return Pl_Rd_Integer(Arg(adr, 0)); } /*-------------------------------------------------------------------------* * BC_ARG_FUNC_ARITY * * * *-------------------------------------------------------------------------*/ static int BC_Arg_Func_Arity(WamWord arg_word, int *arity) { WamWord word, tag_mask; WamWord *stc_adr; DEREF(arg_word, word, tag_mask); /* functor/arity */ stc_adr = UnTag_STC(word); DEREF(Arg(stc_adr, 1), word, tag_mask); /* arity */ *arity = UnTag_INT(word); DEREF(Arg(stc_adr, 0), word, tag_mask); /* functor */ return UnTag_ATM(word); } /*-------------------------------------------------------------------------* * BC_ARG_MODULE_FUNC_ARITY * * * *-------------------------------------------------------------------------*/ static int BC_Arg_Module_Func_Arity(WamWord arg_word, int *func, int *arity) { WamWord word, tag_mask; WamWord *stc_adr; int module = -1; DEREF(arg_word, word, tag_mask); /* module:functor/arity or func/arity*/ stc_adr = UnTag_STC(word); if (Functor_And_Arity(stc_adr) == Functor_Arity(ATOM_CHAR(':'), 2)) { DEREF(Arg(stc_adr, 0), word, tag_mask); module = UnTag_ATM(word); arg_word = Arg(stc_adr, 1); } *func = BC_Arg_Func_Arity(arg_word, arity); return module; } /*-------------------------------------------------------------------------* * Part II. Byte-Code emulation * * * *-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------* * EXECUTE_PRED * * * *-------------------------------------------------------------------------*/ static WamCont Execute_Pred(int module, int func, int arity, WamWord *arg_adr, WamWord call_info_word) { PredInf *pred; int i; pred = Pl_Lookup_Pred_Visible(module, func, arity); if (pred == NULL) { /* case: fail/0 from '$call_from_debugger' */ if (func != atom_fail || arity != 0) { Pl_Call_Info_Bip_Name_1(call_info_word); Pl_Unknown_Pred_Error(module, func, arity); } return ALTB(B); /* i.e. fail */ } #if 0 /* we need a test: pred module != calling module (notion of home module ?, first = typein-module of top-level) */ if (!(pred->prop & MASK_PRED_EXPORTED)) { WamWord word = Pl_Build_Pred_Indic_Error(pred); Pl_Err_Permission(pl_permission_operation_execute, pl_permission_type_non_exported_procedure, word); } #endif if (arg_adr != &A(0)) memcpy(&A(0), arg_adr, sizeof(WamWord) * arity); #if 1 if (pred->prop & MASK_PRED_META_PRED) { MetaSpec meta_spec = pred->meta_spec; int x; for (i = 0; i < arity; i++) { x = meta_spec & 0xf; meta_spec >>= 4; if (x <= META_PRED_ARG_COLON) { #if 0 printf("in meta-call to %s/%d meta-arg %d = ", pl_atom_tbl[func].name, arity, i); Pl_Write_Simple(A(i)); #endif A(i) = Pl_Put_Meta_Term(module, A(i)); #if 0 printf(" becomes "); Pl_Write_Simple(A(i)); printf("\n"); #endif } } } #endif if (pred->prop & MASK_PRED_NATIVE_CODE) /* native code */ return (WamCont) (pred->codep); return BC_Emulate_Pred(pred); } /*-------------------------------------------------------------------------* * PL_BC_CALL_INITIAL * * * *-------------------------------------------------------------------------*/ WamCont Pl_BC_Call_Initial(int module, int func, int arity, WamWord *arg_adr, WamWord goal_word, int caller_func, int caller_arity, Bool debug_call) { WamWord call_info_word = Tag_INT(Call_Info(caller_func, caller_arity, debug_call)); WamWord module_word; WamCont codep; Pl_Set_Bip_Name_2(Tag_ATM(caller_func), Tag_INT(caller_arity)); /* NB: arg_adr can be &A(0): beware when writting in A(i) to not overwrite args */ terminal_rec: /* treat control constructs */ switch(arity) { case 0: if (func == atom_fail) return ALTB(B); /* i.e. fail */ if (func == pl_atom_true || func == ATOM_CHAR('!')) return UnAdjust_CP(CP); break; case 1: if (func == atom_call) { goal_word = *arg_adr; arg_adr = Pl_Rd_Callable_Check(goal_word, &func, &arity); goto terminal_rec; } if (func == atom_throw) { A(0) = *arg_adr; A(1) = Tag_ATM(module); /* FIXME should be CallerModule or CallerMFA */ A(2) = call_info_word; return (WamCont) Prolog_Predicate(THROW_INTERNAL, 3); } #ifdef META_TERM_HIDDEN if (func == pl_atom_meta_term) { arg_adr++; /* skip Offset (should we test it ?) */ if (Tag_Mask_Of(*arg_adr) != TAG_ATM_MASK) /* should be dereferenced */ break; /* treat it as a normal goal ! */ module = UnTag_ATM(*arg_adr); goal_word = *++arg_adr; arg_adr = Pl_Rd_Callable_Check(goal_word, &func, &arity); goto terminal_rec; } #endif break; case 2: if (func == ATOM_CHAR(':')) { module = Pl_Rd_Atom_Check(*arg_adr); goal_word = *++arg_adr; arg_adr = Pl_Rd_Callable_Check(goal_word, &func, &arity); goto terminal_rec; } /* complex call: needs Pl_Term_To_Goal transformation */ if (func == ATOM_CHAR(',')) { codep = (WamCont) Prolog_Predicate(CALL_INTERNAL_AND, 5); complex_call: /* NB: arg_adr can be &A(0), thus args can be in A(0) and A(1). Beware */ module_word = Tag_ATM(module); A(0) = Pl_Term_To_Goal(arg_adr[0], module_word, call_info_word); A(1) = Pl_Term_To_Goal(arg_adr[1], module_word, call_info_word); A(2) = module_word; A(3) = call_info_word; A(4) = Pl_Get_Current_Choice(); /* VarCut */ return (WamCont) codep; } if (func == ATOM_CHAR(';')) { codep = (WamCont) Prolog_Predicate(CALL_INTERNAL_OR, 5); goto complex_call; } if (func == atom_if) { codep = (WamCont) Prolog_Predicate(CALL_INTERNAL_IF, 5); goto complex_call; } if (func == atom_soft_if) { codep = (WamCont) Prolog_Predicate(CALL_INTERNAL_SOFT_IF, 5); goto complex_call; } break; case 3: if (func == atom_catch) { if (arg_adr != &A(0)) { A(0) = *arg_adr++; A(1) = *arg_adr++; A(2) = *arg_adr; } A(3) = Tag_ATM(module); A(4) = call_info_word; return (WamCont) Prolog_Predicate(CATCH_INTERNAL, 5); } break; } /* here we have a simple predicate to call */ if (pl_debug_call_code != NULL) /* inform the debugger if active */ { if (goal_word == NOT_A_WAM_WORD) goal_word = Pl_Mk_Compound(func, arity, arg_adr); A(0) = goal_word; A(1) = Tag_ATM(module); A(2) = call_info_word; return pl_debug_call_code; } return Execute_Pred(module, func, arity, arg_adr, call_info_word); } /*-------------------------------------------------------------------------* * PL_BC_CALL_5 * * * * called by '$call'/4 and '$call_no_debug'/4 * *-------------------------------------------------------------------------*/ WamCont Pl_BC_Call_5(WamWord goal_word, WamWord module_word, WamWord caller_func_word, WamWord caller_arity_word, Bool debug_call) { int module, func, arity; int caller_func, caller_arity; WamWord *arg_adr; Pl_Set_Bip_Name_2(caller_func_word, caller_arity_word); module = Pl_Rd_Atom_Check(module_word); Pl_Set_Calling_Module(module); caller_func = Pl_Rd_Atom(caller_func_word); caller_arity = Pl_Rd_Integer(caller_arity_word); arg_adr = Pl_Rd_Callable_Check(goal_word, &func, &arity); return Pl_BC_Call_Initial(module, func, arity, arg_adr, goal_word, caller_func, caller_arity, debug_call); } /*-------------------------------------------------------------------------* * PL_BC_CALL_TERMINAL_PRED_4 * * * *-------------------------------------------------------------------------*/ WamCont Pl_BC_Call_Terminal_Pred_4(WamWord pred_word, WamWord module_word, WamWord call_info_word, WamWord first_call_word) { int func, arity; WamWord *arg_adr; int module; Pl_Call_Info_Bip_Name_1(call_info_word); module = Pl_Rd_Atom_Check(module_word); /* check instantiation error */ arg_adr = Pl_Rd_Callable(pred_word, &func, &arity); /* we know it is a callable */ debug_call = (call_info_word & (1 << TAG_SIZE_LOW)) != 0; if (pl_debug_call_code != NULL && debug_call && (first_call_word & (1 << TAG_SIZE_LOW))) { A(0) = pred_word; A(1) = module_word; A(2) = call_info_word; return pl_debug_call_code; } return Execute_Pred(module, func, arity, arg_adr, call_info_word); } /*-------------------------------------------------------------------------* * BC_EMULATE_PRED * * * *-------------------------------------------------------------------------*/ static WamCont BC_Emulate_Pred(PredInf *pred) { DynPInf *dyn; DynCInf *clause; WamCont codep; int arity; while((dyn = (DynPInf *) pred->dyn) != NULL) { arity = dyn->arity; A(arity) = Pl_Get_Current_Choice(); /* init cut register */ A(arity + 1) = debug_call; clause = Pl_Scan_Dynamic_Pred(pred, A(0), pred->mod->module, Functor_Of(pred->f_n), arity, (PlLong (*)()) BC_Emulate_Pred_Alt, DYN_ALT_FCT_FOR_JUMP, arity + 2, &A(0)); if (clause == NULL) break; codep = BC_Emulate_Clause(clause); if (codep) return (codep); pred = glob_pred; } return ALTB(B); } /*-------------------------------------------------------------------------* * BC_EMULATE_PRED_ALT * * * *-------------------------------------------------------------------------*/ static WamCont BC_Emulate_Pred_Alt(DynCInf *clause, WamWord *w) { DynPInf *dyn; int arity; WamCont codep; WamWord *adr; dyn = clause->dyn; arity = dyn->arity; adr = &A(0); do *adr++ = *w++; while (--arity >= 0); /* >=0 to also restore cut register */ debug_call = *w; codep = BC_Emulate_Clause(clause); return (codep) ? codep : BC_Emulate_Pred(glob_pred); } /*-------------------------------------------------------------------------* * BC_EMULATE_CLAUSE * * * *-------------------------------------------------------------------------*/ static WamCont BC_Emulate_Clause(DynCInf *clause) { WamWord head_word, body_word; WamWord *arg_adr; BCWord *bc; int module, func, arity; int i; bc = (BCWord *) clause->byte_code; if (bc) /* emulated code */ return BC_Emulate_Byte_Code(bc); module = clause->dyn->pred->mod->module; /* traverse back links to obtain module */ /* interpreted code */ Pl_Copy_Clause_To_Heap(clause, &head_word, &body_word); arg_adr = Pl_Rd_Callable_Check(head_word, &func, &arity); for (i = 0; i < arity; i++) /* head unification */ if (!Pl_Unify(A(i), *arg_adr++)) return ALTB(B); /* fail */ A(3) = A(arity); /* NB: must be first */ A(0) = body_word; A(1) = Tag_ATM(module); A(2) = Tag_INT(Call_Info(func, arity, debug_call)); return (WamCont) Prolog_Predicate(CALL_INTERNAL_WITH_CUT, 4); } /*-------------------------------------------------------------------------* * BC_EMULATE_BYTE_CODE * * * * Return NULL for a call to an emulate pred (then in BC_Emulate_Pred). * *-------------------------------------------------------------------------*/ static WamCont BC_Emulate_Byte_Code(BCWord *bc) { int code_op; BCWord w; int x0, x, y; int w1; PlLong l; WamCont codep; int func, arity; int module; PredInf *pred; C64To32 cv; int caller_func, caller_arity; bc_loop: w = *bc++; switch (code_op = BC_Op(w)) { case GET_X_VARIABLE: x0 = BC1_X0(w); x = BC1_XY(w); X(x) = X(x0); goto bc_loop; case GET_Y_VARIABLE: x0 = BC1_X0(w); y = BC1_XY(w); Y(E, y) = X(x0); goto bc_loop; case GET_X_VALUE: x0 = BC1_X0(w); x = BC1_XY(w); if (!Pl_Unify(X(x), X(x0))) goto fail; goto bc_loop; case GET_Y_VALUE: x0 = BC1_X0(w); y = BC1_XY(w); if (!Pl_Unify(Y(E, y), X(x0))) goto fail; goto bc_loop; case GET_ATOM: x0 = BC1_X0(w); if (!Pl_Get_Atom(BC1_Atom(w), X(x0))) goto fail; goto bc_loop; case GET_ATOM_BIG: x0 = BC1_X0(w); w1 = bc->word; bc++; if (!Pl_Get_Atom(w1, X(x0))) goto fail; goto bc_loop; case GET_INTEGER: x0 = BC1_X0(w); if (!Pl_Get_Integer(BC1_Int(w), X(x0))) goto fail; goto bc_loop; case GET_INTEGER_BIG: x0 = BC1_X0(w); #if WORD_SIZE == 32 l = bc->word; bc++; #else cv.u[0] = bc->word; bc++; cv.u[1] = bc->word; bc++; l = cv.l; #endif if (!Pl_Get_Integer(l, X(x0))) goto fail; goto bc_loop; case GET_FLOAT: x0 = BC1_X0(w); cv.u[0] = bc->word; bc++; cv.u[1] = bc->word; bc++; if (!Pl_Get_Float(cv.d, X(x0))) goto fail; goto bc_loop; case GET_NIL: x0 = BC1_X0(w); if (!Pl_Get_Nil(X(x0))) goto fail; goto bc_loop; case GET_LIST: x0 = BC1_X0(w); if (!Pl_Get_List(X(x0))) goto fail; goto bc_loop; case GET_STRUCTURE: x0 = BC1_X0(w); arity = BC1_Arity(w); func = bc->word; bc++; if (!Pl_Get_Structure(func, arity, X(x0))) goto fail; goto bc_loop; case PUT_X_VARIABLE: x0 = BC1_X0(w); x = BC1_XY(w); X(x) = X(x0) = Pl_Put_X_Variable(); goto bc_loop; case PUT_Y_VARIABLE: x0 = BC1_X0(w); y = BC1_XY(w); X(x0) = Pl_Put_Y_Variable(&Y(E, y)); goto bc_loop; case PUT_VOID: x0 = BC1_X0(w); X(x0) = Pl_Put_X_Variable(); goto bc_loop; case PUT_X_VALUE: x0 = BC1_X0(w); x = BC1_XY(w); X(x0) = X(x); goto bc_loop; case PUT_Y_VALUE: x0 = BC1_X0(w); y = BC1_XY(w); X(x0) = Y(E, y); goto bc_loop; case PUT_Y_UNSAFE_VALUE: x0 = BC1_X0(w); y = BC1_XY(w); X(x0) = Pl_Put_Unsafe_Value(Y(E, y)); goto bc_loop; case PUT_ATOM: x0 = BC1_X0(w); X(x0) = Pl_Put_Atom(BC1_Atom(w)); goto bc_loop; case PUT_ATOM_BIG: x0 = BC1_X0(w); w1 = bc->word; bc++; X(x0) = Pl_Put_Atom(w1); goto bc_loop; case PUT_INTEGER: x0 = BC1_X0(w); X(x0) = Pl_Put_Integer(BC1_Int(w)); goto bc_loop; case PUT_INTEGER_BIG: x0 = BC1_X0(w); #if WORD_SIZE == 32 l = bc->word; bc++; #else cv.u[0] = bc->word; bc++; cv.u[1] = bc->word; bc++; l = cv.l; #endif X(x0) = Pl_Put_Integer(l); goto bc_loop; case PUT_FLOAT: x0 = BC1_X0(w); cv.u[0] = bc->word; bc++; cv.u[1] = bc->word; bc++; X(x0) = Pl_Put_Float(cv.d); goto bc_loop; case PUT_NIL: x0 = BC1_X0(w); X(x0) = NIL_WORD; /* faster than Pl_Put_Nil() */ goto bc_loop; case PUT_LIST: x0 = BC1_X0(w); X(x0) = Pl_Put_List(); goto bc_loop; case PUT_STRUCTURE: x0 = BC1_X0(w); arity = BC1_Arity(w); func = bc->word; bc++; X(x0) = Pl_Put_Structure(func, arity); goto bc_loop; case PUT_META_TERM: x0 = BC1_X0(w); x = BC1_XY(w); module = bc->word; bc++; X(x) = Pl_Put_Meta_Term(module, X(x0)); goto bc_loop; case MATH_LOAD_X_VALUE: x0 = BC1_X0(w); x = BC1_XY(w); Pl_Math_Load_Value(X(x), &X(x0)); goto bc_loop; case MATH_LOAD_Y_VALUE: x0 = BC1_X0(w); y = BC1_XY(w); Pl_Math_Load_Value(Y(E, y), &X(x0)); goto bc_loop; case UNIFY_X_VARIABLE: x = BC2_XY(w); X(x) = Pl_Unify_Variable(); goto bc_loop; case UNIFY_Y_VARIABLE: y = BC2_XY(w); Y(E, y) = Pl_Unify_Variable(); goto bc_loop; case UNIFY_VOID: Pl_Unify_Void(BC2_Int(w)); goto bc_loop; case UNIFY_X_VALUE: x = BC2_XY(w); if (!Pl_Unify_Value(X(x))) goto fail; goto bc_loop; case UNIFY_Y_VALUE: y = BC2_XY(w); if (!Pl_Unify_Value(Y(E, y))) goto fail; goto bc_loop; case UNIFY_X_LOCAL_VALUE: x = BC2_XY(w); if (!Pl_Unify_Local_Value(X(x))) goto fail; goto bc_loop; case UNIFY_Y_LOCAL_VALUE: y = BC2_XY(w); if (!Pl_Unify_Local_Value(Y(E, y))) goto fail; goto bc_loop; case UNIFY_ATOM: if (!Pl_Unify_Atom(BC2_Atom(w))) goto fail; goto bc_loop; case UNIFY_ATOM_BIG: w1 = bc->word; bc++; if (!Pl_Unify_Atom(w1)) goto fail; goto bc_loop; case UNIFY_INTEGER: if (!Pl_Unify_Integer(BC2_Int(w))) goto fail; goto bc_loop; case UNIFY_INTEGER_BIG: #if WORD_SIZE == 32 l = bc->word; bc++; #else cv.u[0] = bc->word; bc++; cv.u[1] = bc->word; bc++; l = cv.l; #endif if (!Pl_Unify_Integer(l)) goto fail; goto bc_loop; case UNIFY_NIL: if (!Pl_Unify_Nil()) goto fail; goto bc_loop; case UNIFY_LIST: if (!Pl_Unify_List()) goto fail; goto bc_loop; case UNIFY_STRUCTURE: arity = BC2_Arity(w); func = bc->word; bc++; if (!Pl_Unify_Structure(func, arity)) goto fail; goto bc_loop; case ALLOCATE: Pl_Allocate(BC2_Int(w)); goto bc_loop; case DEALLOCATE: Pl_Deallocate(); goto bc_loop; case CALL: BCI = (WamWord) (bc + 2) | debug_call; /* use low bit of adr */ CP = Adjust_CP(Prolog_Predicate(BC_EMULATE_CONT, 0)); case EXECUTE: module = BC2_Atom(w); w1 = bc->word; func = Functor_Of(w1); arity = Arity_Of(w1); bc++; if (pl_debug_call_code != NULL && debug_call && Pl_Detect_If_Aux_Name(func) == NULL) { w1 = bc->word; caller_func = Functor_Of(w1); caller_arity = Arity_Of(w1); Prep_Debug_Call(module, func, arity, caller_func, caller_arity); return pl_debug_call_code; } if ((pred = Pl_Lookup_Pred_Visible(module, func, arity)) == NULL) { w1 = bc->word; caller_func = Functor_Of(w1); caller_arity = Arity_Of(w1); Pl_Set_Bip_Name_2(Tag_ATM(caller_func), Tag_INT(caller_arity)); Pl_Unknown_Pred_Error(module, func, arity); goto fail; } #if 0 bc++; /* useless since CP already set */ #endif glob_pred = pred; return NULL; /* to then call BC_Emulate_Pred */ case CALL_NATIVE: case EXECUTE_NATIVE: module = BC2_Atom(w); w1 = bc->word; func = Functor_Of(w1); arity = Arity_Of(w1); bc++; Compute_Branch_Adr(bc, codep); if (code_op == CALL_NATIVE) { BCI = (WamWord) bc | debug_call; /* use low bit of adr */ CP = Adjust_CP(Prolog_Predicate(BC_EMULATE_CONT, 0)); } if (pl_debug_call_code != NULL && debug_call) { Prep_Debug_Call(module, func, arity, 0, 0); return pl_debug_call_code; } return codep; case PROCEED: return UnAdjust_CP(CP); case FAIL: if (pl_debug_call_code != NULL && debug_call) { /* invoke the debugger which will then call fail/0 */ Prep_Debug_Call(pl_atom_system, atom_fail, 0, 0, 0); return pl_debug_call_code; } goto fail; case GET_CURRENT_CHOICE_X: x = BC2_XY(w); X(x) = Pl_Get_Current_Choice(); goto bc_loop; case GET_CURRENT_CHOICE_Y: y = BC2_XY(w); Y(E, y) = Pl_Get_Current_Choice(); goto bc_loop; case CUT_X: x = BC2_XY(w); Pl_Cut(X(x)); goto bc_loop; case CUT_Y: y = BC2_XY(w); Pl_Cut(Y(E, y)); goto bc_loop; case SOFT_CUT_X: x = BC2_XY(w); Pl_Soft_Cut(X(x)); goto bc_loop; case SOFT_CUT_Y: y = BC2_XY(w); Pl_Soft_Cut(Y(E, y)); goto bc_loop; } fail: return ALTB(B); } /*-------------------------------------------------------------------------* * PL_BC_EMULATE_CONT_0 * * * *-------------------------------------------------------------------------*/ WamCont Pl_BC_Emulate_Cont_0(void) { WamCont codep; BCWord *bc; debug_call = BCI & 1; bc = (BCWord *) ((BCI >> 1) << 1); codep = BC_Emulate_Byte_Code(bc); return (codep) ? codep : BC_Emulate_Pred(glob_pred); } /*-------------------------------------------------------------------------* * PREP_DEBUG_CALL * * * *-------------------------------------------------------------------------*/ static void Prep_Debug_Call(int module, int func, int arity, int caller_func, int caller_arity) { int i; WamWord word; if (arity == 0) A(0) = Tag_ATM(func); else { word = Tag_STC(H); Global_Push(Functor_Arity(func, arity)); for (i = 0; i < arity; i++) Global_Push(A(i)); A(0) = word; } A(1) = Tag_ATM(module); A(2) = Tag_INT(Call_Info(caller_func, caller_arity, debug_call)); } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/BipsPl/write_supp.h���������������������������������������������������������������0000644�0001750�0001750�00000007403�13021324543�015655� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Prolog buit-in predicates * * File : write_supp.h * * Descr.: term writing support - header file * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ /*---------------------------------* * Constants * *---------------------------------*/ #define WRITE_QUOTED 1 #define WRITE_IGNORE_OP 2 #define WRITE_NUMBER_VARS 4 #define WRITE_NAME_VARS 8 #define WRITE_SPACE_ARGS 16 #define WRITE_PORTRAYED 32 /*---------------------------------* * Type Definitions * *---------------------------------*/ /*---------------------------------* * Global Variables * *---------------------------------*/ #ifdef WRITE_SUPP_FILE int pl_last_writing; #else extern int pl_last_writing; #endif /*---------------------------------* * Function Prototypes * *---------------------------------*/ void Pl_Write_Term(StmInf *pstm, int depth, int prec, int mask, WamWord *above_H, WamWord term_word); void Pl_Write(WamWord term_word); void Pl_Write_A_Full_Stop(StmInf *pstm); void Pl_Write_A_Char(StmInf *pstm, int c); char *Pl_Float_To_String(double d); int Get_Print_Stm(void); �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/WINDOWS���������������������������������������������������������������������������0000644�0001750�0001750�00000023325�13021324543�013170� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� Windows compilation/installation instructions Daniel Diaz NB: for Windows 64 bits ALSO read the file WINDOWS64. See also this file to use mingw64 (which also provides a 32 bits version of gcc). This file describes how to compile GNU Prolog on Windows machines. There are actually 3 ports: - pure Win32 with MS Visual C++ (MSVC++) - pure Win32 with MinGW (gcc) or mingw64 gcc - using Cygwin with Cygwin (gcc) or mingw64 gcc However, even to compile a source distribution of GNU Prolog with MSVC, you need a Unix-like environment (providing standard Unix tools like: make, rm, cp, ...). You can either use Cygwin or MinGW/MSYS for this. NB: The current version DOES NOT accept spaces in pathnames. Do not uncompress your source distribution under a pathname containing spaces. Do not install it under a pathname containing spaces. 1) Installing and configuring Cygwin ------------------------------------ Cygwin is a Unix-like environment for Windows. It consists of two parts: - a DLL (cygwin1.dll) which acts as a Linux emulation layer providing substantial Linux API functionality. - a collection of tools, which provide Linux look and feel. Refer to www.cygwin.com to properly install Cygwin. The resulting system is installed under something like c:\cygwin. NB: If you want to share a file system (Network Drive under Windows) and encounter some problems with permissions (e.g. for execute). You can add options for the mount of the remote directory. Add noacl,exec in the options for the mount point in /etc/fstab. You can set some environmant variables in the .bat launching cygwin (e.g. c:\cygwin\cygwin.bat) since environment variables are inherited by the Cygwin shell. For instance if you use MSVC++ you can add to cygwin.bat for the 32 bits version of MSVC: call "C:\Program Files (x86)\Microsoft Visual Studio 11.0\VC\vcvarsall.bat" or for the 64 bits version of MSVC: call "C:\Program Files (x86)\Microsoft Visual Studio 11.0\VC\vcvarsall.bat" x64 You can also modify your .bashrc file to set the PATH variable for the tools you will use. Similarly if you want to use the Microsoft HTML Help Workshop (see below) you can add something like "C:\Program Files\HTML Help Workshop" to your PATH in the .bat file (or '/cygdrive/c/Program Files/HTML Help Workshop' in your .bashrc file). For example to add Inno Setup: PATH=$PATH:'/c/Program Files/Inno Setup 5' or PATH=$PATH:'/c/Program Files (x86)/Inno Setup 5' The gcc version provided by Cygwin is a cygwin port of gcc (it uses cygwin1.dll). By default it generates a code using cygwin1.dll. This DLL is a layer which emulates POSIX on the top of Windows (Win32). 2) Installing and configuring MinGW/MSYS ---------------------------------------- MinGW (Minimalist GNU For Windows) is a collection of freely available and freely distributable Windows specific header files and import libraries combined with GNU toolsets that allow one to produce native Windows programs that do not rely on any 3rd-party C runtime DLLs. MSYS is A Minimal SYStem to provide POSIX/Bourne configure scripts the ability to execute and create a Makefile used by make. Refer to www.mingw.org for more information (how to get MinGW/MSYS and all needed tools). NB: if you want to share the same home as in cygwin set HOME variable in /etc/profile (juste before the test if [ -z "$HOME" ]...) NB: if you want your .bash_profile to be executed, add this line at the end of /etc/profile (in c:\msys\1.0\etc): if [ -f "$HOME/.bash_profile" ]; then source "$HOME/.bash_profile"; fi NB: if you want to use the same /tmp as under cygwin (let us say c:\cygwin\tmp) add this lines in the msys.bat launching msys (e.g. in c:\MinGW\msys\1.0\msys.bat) SET TEMP=c:\cygwin\tmp SET TMP=c:\cygwin\tmp SET TMPDIR=c:\cygwin\tmp The gcc version provided by MinGW is a native win32 port of gcc. It generates a code for native win32. By default, under MinGW/MSYS, the Win32 GUI console is compiled. For this you need the HTML Help Workshop. See below on how to get/install it. You can avoid the GUI console using ./configure --disable-gui-console (see INSTALL). 3) Compiling GNU Prolog using Cygwin or MinGW/MSYS -------------------------------------------------- Launch a shell (Cygwin or MSYS) and follow the classical installation procedure (see ../INSTALL file), i.e.: ./configure make make install The default gcc will be used (the one using cygwin1.dll and producing code using cygwin1.dll) under cygwin and native win32 gcc under msys. 4) Compiling GNU Prolog using MSVC++ ------------------------------------ You need MSVC++. GNU Prolog has been tested with Microsoft Visual Studio 2012 (Professional Edition, i.e. cl.exe version 17.00). NB: with previous MSVC version it was also necessary to install this SDK (or more recent version) : Microsoft Windows SDK for Windows 7 and .NET Framework 4 from http://www.microsoft.com/downloads/dlx/en-us/listdetailsview.aspx?FamilyID=6b6c21d2-2006-4afa-9702-529fa782d63b Once installed, you have to launch cygwin with the correct PATH, INCLUDE, LIB environment variables. There is a .bat file provided with the MS compiler e.g. vcvarsall.bat (or older versions: vcvarvs32.bat or vsvar32.bat). See above on how to execute this .bat in the cygwin.bat lauching script. NB: for MSVC6.0: its lib directory should appear before the lib directory of the SDK (else an error occurs when linking the GUI console). See also: http://msdn.microsoft.com/en-us/library/f2ccy3wt%28v=VS.100%29.aspx Another way to lauch a cygwin (or MSYS) shell with correct environment variables is to launch a DOS prompt window and to execute the vcvarsall.bat (or better to execute the "Developer Command Prompt for VS" (from the Windows Start Menu | MVS | VS Tools). Then execute cygwin (generally using c:\cygwin\cygwin.bat). NB: cygwin provides a /bin/link.exe command which can shadow the Microsoft linker (also called link.exe). If you encounter problem the simplest way to solve it is to rename /bin/link.exe of cygwin. Finally, you need the MinGW assembler (called as.exe). Copy it under a directory inside your PATH (for instance in /bin) under the name mingw-as.exe. A version can be found at: http://gprolog.org/mingw-as.exe Once MSVC++ and the SDK are well installed use --with-msvc at configure time: ./configure --with-msvc make make install By default, the GUI console is compiled (sources in W32GUICons) unless you use ./configure --disable-gui-console. See the ../INSTALL file for further information. Even if compiled with the GUI it is possible to avoid it (and run in console mode) a Prolog program setting the environment variable LINEDIT to a string containing gui=no, e.g. bash: export LINEDIT='gui=no', windows: SET LINEDIT=gui=no. 5) Using Microsoft HTML Help ---------------------------- NB: This is useless in recent MS Visual Studio 2012 If you compile under native Win32 with the GUI Console (see above), you can have a direct access to the GNU Prolog manual (with contextual help, index, table of contents, search). For this we use the Microsoft HMLT Help facility. which is the standard help system for the Win32 platforms (replacing old WinHelp). It is mainly based on HTML files + add-ons (table of contents, index, search facilities,...). A SDK is freely available as a "HTML Help Workshop". There are 2 parts: a compiler to create a .chm version of the documentation (see doc/README) and a library that makes it possible to use this file from a C program. There is a configure option to prevent the use of HtmlHelp or to use a dynamically loaded version: use --disable-htmlhelp to completely disable HtmlHelp --enable-htmlhelp[=static] to use HtmlHelp statically linked (default) --enable-htmlhelp=dynamic to use HtmlHelp dynamically linked You can get the Microsoft HTML-Help Workshop from http://go.microsoft.com/fwlink/?linkid=14188 (file htmlhelp.exe). In order to access to the compiler you have to add "C:\Program Files\HTML Help Workshop" to your PATH (see file hhvars.bat above). If you have the SDK (see above) the header file htmlhelp.h and the library htmlhel.lib are already present. Else copy them from the workshop directory. For MinGW (I suppose you are under MSYS and mingw is in /c/MinGw): cp /c/Program\ Files/HTML\ Help\ Workshop/include/* /c/MinGW/include/. cp /c/Program\ Files/HTML\ Help\ Workshop/lib/htmlhelp.lib /c/MinGW/lib/libhtmlhelp.a Note: libhtmlhelp.a follows Unix standards for libs. The lib prefix make it possible to use the gcc option -lhtmlhelp (linker option). The .a suffix can be replaced by .lib. Note: when building the GUI console a warning can be displayed by the linker due to some directive placed by MS link.exe in the .lib. It does not matter. The message looks like: Warning: .drectve `-defaultlib:uuid.lib ' unrecognized Consult doc/README for more information about HTML Help Formats. 6) Using Windows Emacs ---------------------- get it from http://ftp.gnu.org/gnu/emacs/windows/ and install it under c:\emacs-<version>, e.g. c:\emacs-24.2 The executables to run are bin\runemacs.exe (to double-click, ie. close the console) bin\emacs.exe (to use from a shell) Define your .emacs in your HOME directory (let's say c:\cygwin\home\diaz) then in c:\emacs-24.2\site-lisp create the file site-start.el with: (setenv "HOME" "c:/cygwin/home/diaz") it wil then execute the .emacs file in your HOME directory 7) Using cygwin Emacs --------------------- install emacs-w32 (cygwin package). Then cp /bin/emacs-w32.exe /bin/emacs.exe To have an icon (desktop and/or quick launch bar) copy runemacs.exe in the cygwin /bin (see above for runemacs.exe) create a shortcut on the desktop and/or quick launch bar modify icon if wanted (take it from runemacs.exe or emacs-w32.exe) modify the starting directory (set your cygwin home) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/����������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13021356407�013014� 5����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/gp-vars-iss.txt.in����������������������������������������������������������0000644�0001750�0001750�00000000561�13021324543�016333� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#define PROLOG_DIALECT "@PROLOG_DIALECT@" #define PROLOG_NAME "@PROLOG_NAME@" #define PROLOG_VERSION "@PROLOG_VERSION@" #define PROLOG_DATE "@PROLOG_DATE@" #define PROLOG_COPYRIGHT "@PROLOG_COPYRIGHT@" #define WIN_TMP_DIR "@WIN_TMP_DIR@" #define WIN_CC_VER "@WIN_CC_VER@" �����������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/addcrlf���������������������������������������������������������������������0000755�0001750�0001750�00000000272�13021324543�014336� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh # add CR (\r) before LF (\n), you should edit this file under emacs with Unix # file mode to see the ^M (CR) in the sed line (to see it use less) sed -e 's/^\(.*\)/\1 /' $* ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/gp-setup.iss����������������������������������������������������������������0000644�0001750�0001750�00000013421�13021324543�015275� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������; GNU Prolog ; Copyright (C) 1999-2014 Daniel Diaz ; ; WIN32 installation script for Inno Setup #include "gp-vars-iss.txt" #define PROLOG_NAME_NO_SPC StringChange(PROLOG_NAME, " ", "-") [Setup] AppName={#PROLOG_NAME} AppVerName={#PROLOG_NAME} version {#PROLOG_VERSION} AppVersion={#PROLOG_VERSION} AppPublisher=Daniel Diaz AppPublisherURL=http://www.gprolog.org AppSupportURL=http://www.gprolog.org AppUpdatesURL=http://www.gprolog.org SetupIconFile=gprolog.ico DefaultDirName={sd}\{#PROLOG_NAME_NO_SPC} DefaultGroupName={#PROLOG_NAME} AllowNoIcons=yes SourceDir={#WIN_TMP_DIR}\gprolog_win32 OutputDir={#WIN_TMP_DIR} OutputBaseFileName=setup-gprolog-{#PROLOG_VERSION}-{#WIN_CC_VER} VersionInfoTextVersion={AppVerName} VersionInfoCopyright={#PROLOG_COPYRIGHT} ChangesEnvironment=yes ChangesAssociations=yes ;Compression=lzma ;SolidCompression=yes PrivilegesRequired=none [Tasks] Name: desktopicon; Description: "Create a &desktop icon"; GroupDescription: "Additional icons:"; Name: assocPl; Description: "&Associate {#PROLOG_NAME} with .pl files"; GroupDescription: "File associations:"; Name: assocPro; Description: "A&ssociate {#PROLOG_NAME} with .pro files"; GroupDescription: "File associations:"; Name: assocProlog; Description: "A&ssociate {#PROLOG_NAME} with .prolog files"; GroupDescription: "File associations:"; [Files] Source: "*.*"; DestDir: "{app}"; Flags: ignoreversion Source: "bin\*.*"; DestDir: "{app}\bin"; Flags: ignoreversion Source: "lib\*.*"; DestDir: "{app}\lib"; Flags: ignoreversion Source: "lib\*.dll"; DestDir: "{app}\bin"; Flags: ignoreversion skipifsourcedoesntexist Source: "include\*.*"; DestDir: "{app}\include"; Flags: ignoreversion Source: "doc\*.*"; DestDir: "{app}\doc"; Flags: ignoreversion Source: "doc\html_node\*.*"; DestDir: "{app}\doc\html_node"; Flags: ignoreversion Source: "examples\ExamplesPl\*.*"; DestDir: "{app}\examples\ExamplesPl"; Flags: ignoreversion Source: "examples\ExamplesFD\*.*"; DestDir: "{app}\examples\ExamplesFD"; Flags: ignoreversion Source: "examples\ExamplesC\*.*"; DestDir: "{app}\examples\ExamplesC"; Flags: ignoreversion [INI] Filename: "{app}\gprolog.url"; Section: "InternetShortcut"; Key: "URL"; String: "http://www.gprolog.org" [Icons] Name: "{group}\{#PROLOG_NAME}"; Filename: "{app}\bin\gprolog.exe" Name: "{group}\Help"; Filename: "{app}\doc\gprolog.chm" Name: "{group}\Html Manual"; Filename: "{app}\doc\html_node\index.html" Name: "{group}\The {#PROLOG_NAME} Web Site"; Filename: "{app}\gprolog.url" Name: "{group}\Uninstall {#PROLOG_NAME}"; Filename: "{uninstallexe}" Name: "{userdesktop}\{#PROLOG_NAME}"; Filename: "{app}\bin\gprolog.exe"; MinVersion: 4,4; Tasks: desktopicon [Registry] ; admin user Root: HKLM; Subkey: "SOFTWARE\{#PROLOG_NAME}"; ValueType: string; ValueName: "Version"; ValueData: "{#PROLOG_VERSION}"; Flags: uninsdeletekey noerror Root: HKLM; Subkey: "SOFTWARE\{#PROLOG_NAME}"; ValueType: string; ValueName: "RootPath"; ValueData: "{app}"; Flags: uninsdeletekey noerror ; non-admin user Root: HKCU; Subkey: "Software\{#PROLOG_NAME}"; ValueType: string; ValueName: "RootPath"; ValueData: "{app}"; Flags: uninsdeletekey Root: HKCU; Subkey: "Software\{#PROLOG_NAME}"; ValueType: string; ValueName: "Version"; ValueData: "{#PROLOG_VERSION}"; Flags: uninsdeletekey ; create an association for .pl, .pro and .prolog files ; admin user Root: HKLM; Subkey: "SOFTWARE\Classes\.pl"; ValueType: string; ValueName: ""; ValueData: "PrologFile"; Flags: uninsdeletekey noerror; Tasks: assocPl; Root: HKLM; Subkey: "SOFTWARE\Classes\.pro"; ValueType: string; ValueName: ""; ValueData: "PrologFile"; Flags: uninsdeletekey noerror; Tasks: assocPro; Root: HKLM; Subkey: "SOFTWARE\Classes\.prolog"; ValueType: string; ValueName: ""; ValueData: "PrologFile"; Flags: uninsdeletekey noerror; Tasks: assocProlog; ; non-admin user Root: HKCU; Subkey: "Software\Classes\.pl"; ValueType: string; ValueName: ""; ValueData: "PrologFile"; Flags: uninsdeletekey; Tasks: assocPl; Root: HKCU; Subkey: "Software\Classes\.pro"; ValueType: string; ValueName: ""; ValueData: "PrologFile"; Flags: uninsdeletekey; Tasks: assocPro; Root: HKCU; Subkey: "Software\Classes\.prolog"; ValueType: string; ValueName: ""; ValueData: "PrologFile"; Flags: uninsdeletekey; Tasks: assocProlog; ; could also use ;Check: not IsAdminLoggedOn ; admin user Root: HKLM; Subkey: "SOFTWARE\Classes\PrologFile"; ValueType: string; ValueName: ""; ValueData: "Prolog File"; Flags: uninsdeletekey noerror; Tasks: assocPl assocPro assocProlog Root: HKLM; Subkey: "SOFTWARE\Classes\PrologFile\DefaultIcon"; ValueType: string; ValueName: ""; ValueData: "{app}\bin\gprolog.exe,0"; Flags: uninsdeletekey noerror; Tasks: assocPl assocPro assocProlog Root: HKLM; Subkey: "SOFTWARE\Classes\PrologFile\shell\open\command"; ValueType: string; ValueName: ""; ValueData: """{app}\bin\gprolog.exe"" --entry-goal ""consult(`%1`)"""; Flags: uninsdeletekey noerror; Tasks: assocPl assocPro assocProlog ; non-admin user Root: HKCU; Subkey: "Software\Classes\PrologFile"; ValueType: string; ValueName: ""; ValueData: "Prolog File"; Flags: uninsdeletekey; Tasks: assocPl assocPro assocProlog Root: HKCU; Subkey: "Software\Classes\PrologFile\DefaultIcon"; ValueType: string; ValueName: ""; ValueData: "{app}\bin\gprolog.exe,0"; Flags: uninsdeletekey; Tasks: assocPl assocPro assocProlog Root: HKCU; Subkey: "Software\Classes\PrologFile\shell\open\command"; ValueType: string; ValueName: ""; ValueData: """{app}\bin\gprolog.exe"" --entry-goal ""consult(`%1`)"""; Flags: uninsdeletekey; Tasks: assocPl assocPro assocProlog [Run] Filename: "{app}\bin\create_bat.exe"; Parameters: """{app}"""; Description: "Create {app}\gprologvars.bat" Filename: "{app}\bin\gprolog.exe"; Description: "Launch {#PROLOG_NAME}"; Flags: nowait postinstall skipifsilent [UninstallDelete] Type: files; Name: "{app}\gprologvars.bat" Type: files; Name: "{app}\gprolog.url" �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/README����������������������������������������������������������������������0000644�0001750�0001750�00000002523�13021324543�013672� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� Building GNU-Prolog Win32 Setup ------------------------------- Auto-extract installation files are created with Inno Setup (version > 5.0). Refer to http://www.jrsoftware.org/ for more information. Note: this works under cygwin or MSYS. Under MSYS it is necessary to first create the distrib under cygwin using make dist (because mingw does not support links). Then simply do (under mingw) make setup (setup-link will NOT work). 1) Building a setup classically ------------------------------- To build a setup for GNU-Prolog: make setup The stages executed are: 1- build a distribution file (gprolog-VERSION.tar.gz) if needed using 'make dist' in the src (parent) directory. 2- copy it under the /tmp 3- uncompres it 4- configure 5- compile locally 6- install it in /tmp/gprolog_win32 7- build the setup auto-extract file The setup file is created in /tmp and called setup-gprolog-VERSION.exe 2) Building a setup fastly -------------------------- If you have locally compiled GNU-Prolog (using './configure' followed by 'make' in the src (parent) directory) you can avoid stages 1, 2, 3, and 5 described above using: make setup-link This will do a ./configure in src (parent) directory to specify /tmp/gprolog_win32 as install dir, then make and make install. The setup file is created similarly. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/gp-vars-iss.txt�������������������������������������������������������������0000644�0001750�0001750�00000000520�13021356407�015725� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#define PROLOG_DIALECT "gprolog" #define PROLOG_NAME "GNU Prolog" #define PROLOG_VERSION "1.4.5" #define PROLOG_DATE "Dec 5 2016" #define PROLOG_COPYRIGHT "Copyright (C) 1999-2015 Daniel Diaz" #define WIN_TMP_DIR "" #define WIN_CC_VER "" ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/compile_install�������������������������������������������������������������0000755�0001750�0001750�00000000375�13021324543�016121� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/sh # compile_install CONFOPT SRCPATH DSTPATH confopt="$1" src="$2" dst="$3" cd $src || exit 1 (cd ../doc; make chm ) || exit 1 rm -rf $dst ./configure $confopt --with-install-dir=$dst --without-links-dir || exit 1 make || exit 1 make install �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/.gitignore������������������������������������������������������������������0000644�0001750�0001750�00000000032�13021324543�014773� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile gp-vars-iss.txt ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/create_bat.c����������������������������������������������������������������0000644�0001750�0001750�00000007454�13021324543�015257� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������/*-------------------------------------------------------------------------* * GNU Prolog * * * * Part : Win32 installation * * File : create_bat.c * * Descr.: gprologvars.bat creation (for command-line mode) * * Author: Daniel Diaz * * * * Copyright (C) 1999-2015 Daniel Diaz * * * * This file is part of GNU Prolog * * * * GNU Prolog is free software: you can redistribute it and/or * * modify it under the terms of either: * * * * - the GNU Lesser General Public License as published by the Free * * Software Foundation; either version 3 of the License, or (at your * * option) any later version. * * * * or * * * * - 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. * * * * or both in parallel, as here. * * * * GNU Prolog 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 copies of the GNU General Public License and * * the GNU Lesser General Public License along with this program. If * * not, see http://www.gnu.org/licenses/. * *-------------------------------------------------------------------------*/ #include <stdio.h> #include <stdlib.h> #include <string.h> #include <io.h> #include <fcntl.h> /*-------------------------------------------------------------------------* * MAIN * * * * argv[1]: the GNU Prolog root path * *-------------------------------------------------------------------------*/ int main(int argc, char *argv[]) { char buff[1024]; int install; FILE *f; if (argc != 2) { fprintf(stderr, "Usage: %s GPROLOG_PATH\n", argv[0]); return 1; } sprintf(buff, "%s\\gprologvars.bat", argv[1]); if ((f = fopen(buff, "wt")) == NULL) { perror(buff); fprintf(stderr, "If needed, add %s\\bin to your PATH - press RETURN\n", argv[1]); fflush(stderr); gets(buff); return 1; } fprintf(f, "@echo off\n"); fprintf(f, "echo Setting environment for using GNU Prolog\n"); fprintf(f, "PATH=%%PATH%%;\"%s\\bin\"\n", argv[1]); fclose(f); return 0; } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Win32/Makefile.in�����������������������������������������������������������������0000644�0001750�0001750�00000002156�13021324543�015061� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������NAME = @PROLOG_DIALECT@ VERSION = @PROLOG_VERSION@ PKG_NAME = @PKG_NAME@ CC = @CC@ @CFLAGS_MACHINE@ CFLAGS = @CFLAGS@ WITH_MSVC = @WITH_MSVC@ WIN_TMP_DIR = @WIN_TMP_DIR@ WIN_CONF_OPT = @WIN_CONF_OPT@ ISCC = iscc.exe AS = @AS@ # the name gprolog_win32 is also used inside gp-setup.iss.in TMPDIR=/tmp/gprolog_win32 # put create-bat as a target (not as a dependency) to avoid conflict 32/64 bits create-bat: create_bat.c $(CC) $(CFLAGS) @CC_EXE_NAME_OPT@create_bat@EXE_SUFFIX@ create_bat.c compile: (cd ..; make copy_dist_tree distdir=/tmp/) compile_install "$(WIN_CONF_OPT)" /tmp/$(PKG_NAME)/src $(TMPDIR) compile-link: compile_install "$(WIN_CONF_OPT)" .. $(TMPDIR) setup: compile create-setup setup-link: compile-link create-setup create-setup: create-bat if test $(WITH_MSVC) != no; then cp `which $(AS)` $(TMPDIR)/bin; fi cp create_bat@EXE_SUFFIX@ $(TMPDIR)/bin $(ISCC) gp-setup.iss ../$(PKG_NAME).tar.gz: (cd ..; make dist) clean: rm -rf create_bat@OBJ_SUFFIX@ create_bat@EXE_SUFFIX@ /tmp/$(PKG_NAME).tar.gz /tmp/$(PKG_NAME) $(TMPDIR) distclean: clean ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/WINDOWS64�������������������������������������������������������������������������0000644�0001750�0001750�00000010264�13021324543�013340� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� Windows 64 compilation/installation instructions Daniel Diaz NB: Please read the src/WINDOWS file first ! This file only documents the 64 bits specific part. The preliminar port to Win64 has been done in Jan 2011 by Jasper Taylor <jasper@simulistics.com>. Many thanks to him ! I have then added some finishing touches. 1) Compiling with mingw64 ------------------------- I have tested it under x86-64/Windows 7 and 8. I use Cygwin or MSYS as compilation environment (see file WINDOWS). I used mingw-w64 which delivers a complete toolchain (runtime, headers, and libs) for developing 64 bit (x64), as well as 32 bit (x86), windows applications using gcc. It possible to get mingw-w64 from http://mingw-w64.sourceforge.net/ or, for cygwin, with the cygwin setup.exe utility (selecting the mingw package). Tested with mingw64/mingw32 gcc version 4.5.3, 4.6.3 and 4.7.0 With the cygwin package things are installed in: /usr/x86_64-w64-mingw32/ and in /usr/i686-w64-mingw32/ bin lib lib64 sys-root sys-root/mingw sys-root/mingw/bin sys-root/mingw/include sys-root/mingw/lib The toolchain executables are all prefixed with: x86_64-w64-mingw32 (e.g. x86_64-w64-mingw32-gcc.exe) to produce 64 bits objs/execs/libs/... and with i686-w64-mingw32 (e.g. i686-w64-mingw32-gcc.exe) to produce 32 bits objs/execs/libs/... Strictly speaking i686-... are not needed here (since we are interested in 64 bits) Using original mingw64 packages If you are under MSYS or if you prefer a more recent version under Cygwin, you can dowload mingw64 from the official site: http://mingw-w64.sourceforge.net/ From the left menu: - "What do I download ?", read it to know what you download - "WIN64 Downloads" (to run under a 64 bits Windows) - "WIN32 Downloads" (to run under a 32 or 64 bits Windows) NB: on each arch (32 or 64) you can produce 32 bits (prefix i686) or 64 bits (prefix x86_64) code. You can either chose Automated Buils or Personal Builds (in this one I use rubenvb buils which also include gdb). HTML Help --------- To use HtmlHelp you maybe need to copy: the header file: htmlhtlp.h in /usr/x86_64-w64-mingw32/sys-root/mingw/include/htmlhelp.h htmlhtlp.h in /usr/i686-w64-mingw32/sys-root/mingw/include/htmlhelp.h the lib (beware to copy the adequate version of the lib 32 != 64) copy + rename the 64 bits version of Htmlhelp.lib as /usr/x86_64-w64-mingw32/sys-root/mingw/lib/libhtmlhelp.a (you can find it for instance in C:/Program Files (x86)/Microsoft SDKs/Windows/v7.0A/Lib/x64 or in C:\Program Files (x86)\Windows Kits\8.0\Lib\win8\um\x86) copy + rename the 32 bits version of Htmlhelp.lib as /usr/i686-w64-mingw32/sys-root/mingw/lib/libhtmlhelp.a (you can find it for instance in C:/Program Files (x86)/Microsoft SDKs/Windows/v7.0A/Lib/ or in C:\Program Files (x86)\Windows Kits\8.0\Lib\win8\um\x64) Configuration ------------- Open a Cygwin shell and go to GNU Prolog source directory: type ./configure --host=x86_64-w64-mingw32 (or ./configure --host=i686-w64-mingw32 to build a 32 bits version) NB: with this configuration all needed tools (gcc, ar, ...) are first searched prefixed with x86_64-w64-mingw32 (or i686-w64-mingw32) as provided by the cygwin package. then make make check make install 2) Compiling GNU Prolog using MSVC++ ------------------------------------ See the same section in file WINDOWS (it is basically the same process). Be sure yuo run a cygwin which invokes the 64 bits version of the MSVC++ compiler to check run 'cl' and see if you obtain something with a x64 like: Microsoft (R) C/C++ Optimizing Compiler Version 17.00.50727.1 for x64 Basically you have to set PATH and other variables invoking the MSVS .bat call "C:\Program Files (x86)\Microsoft Visual Studio 11.0\VC\vcvarsall.bat" x64 Finally, you need the YASM assembler (called yasm.exe). Copy it under a directory inside your PATH (for instance in /bin) under the name yasm-win64.exe. A version can be found at: http://gprolog.org/yasm-win64.exe 3) Limitations -------------- Currently hardware detection of stack overflows does not work (SEH is not yet implemented in mingw64). ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/DEVELOPMENT�����������������������������������������������������������������������0000644�0001750�0001750�00000002733�13021324543�013620� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Information for developers (see also file PORTING) Get the sources from the GIT repo: git clone git://git.code.sf.net/p/gprolog/code gprolog-code cd gprolog-code (then it will be possible to use 'git pull' to stay up to date). If you want to test/update/modify GNU-Prolog without having to install each working (intermediate) version simply use: cd src . ./SETVARS (under sh/bash) source ./CSHSETVARS (under csh/tcsh) This updates the PATH variable and makes it possible to invoke gplc (and gprolog) which resides in src/TopComp. gplc then detects that it is in a development mode (use gplc -v to check this) and will use the libraries residing in src/EnginePl, src/BipsPl, src/EngineFD, src/BipsFD, src/Linedit (i.e the current development libraries and objects). To configure: autoconf (only needed if configure.in has been modified or if configure does not exist) ./configure or for debugging (without optimizations) ./configure --with-c-flags=debug then: make To test a new (pure) Prolog feature, define a file t.pl and t_c.c (maybe empty) in BipsPl: cd BipsPl modify t.pl and t_c.c make t ./t (to test) There is an entry in the Makefile that reconstruct t from t.pl and t_c.c. Similarly, to test a new Prolog+FD feature, use t.pl, t_c.c and t_fd.fd in BipsFD: cd BipsFD modify t.pl and/or t_c.c and/or t_fd.fd make t ./t (to test) There is an entry in the Makefile that reconstruct t from t.pl, t_c.c and t_fd.fd. �������������������������������������gprolog-1.4.5/src/config.guess����������������������������������������������������������������������0000755�0001750�0001750�00000127432�13021324543�014437� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, # 2011, 2012 Free Software Foundation, Inc. timestamp='2012-02-10' # This file 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, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # Originally written by Per Bothner. Please send patches (context # diff format) to <config-patches@gnu.org> and include a ChangeLog # entry. # # This script attempts to guess a canonical system name similar to # config.sub. If it succeeds, it prints the system name on stdout, and # exits with 0. Otherwise, it exits with 1. # # You can get the latest version of this script from: # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] Output the configuration name of the system \`$me' is run on. Operation modes: -h, --help print this help, then exit -t, --time-stamp print date of last modification, then exit -v, --version print version number, then exit Report bugs and patches to <config-patches@gnu.org>." version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." help=" Try \`$me --help' for more information." # Parse command line while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) echo "$timestamp" ; exit ;; --version | -v ) echo "$version" ; exit ;; --help | --h* | -h ) echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. break ;; -* ) echo "$me: invalid option $1$help" >&2 exit 1 ;; * ) break ;; esac done if test $# != 0; then echo "$me: too many arguments$help" >&2 exit 1 fi trap 'exit 1' 1 2 15 # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires # temporary files to be created and, as you can see below, it is a # headache to deal with in a portable fashion. # Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still # use `HOST_CC' if defined, but it is deprecated. # Portable tmp directory creation inspired by the Autoconf team. set_cc_for_build=' trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; : ${TMPDIR=/tmp} ; { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; dummy=$tmp/dummy ; tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; case $CC_FOR_BUILD,$HOST_CC,$CC in ,,) echo "int x;" > $dummy.c ; for c in cc gcc c89 c99 ; do if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then CC_FOR_BUILD="$c"; break ; fi ; done ; if test x"$CC_FOR_BUILD" = x ; then CC_FOR_BUILD=no_compiler_found ; fi ;; ,,*) CC_FOR_BUILD=$CC ;; ,*,*) CC_FOR_BUILD=$HOST_CC ;; esac ; set_cc_for_build= ;' # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) if (test -f /.attbin/uname) >/dev/null 2>&1 ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward # compatibility and a consistent mechanism for selecting the # object file format. # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ /usr/sbin/$sysctl 2>/dev/null || echo unknown)` case "${UNAME_MACHINE_ARCH}" in armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; sh5el) machine=sh5le-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently, or will in the future. case "${UNAME_MACHINE_ARCH}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? os=netbsd else os=netbsdelf fi ;; *) os=netbsd ;; esac # The OS release # Debian GNU/NetBSD machines have a different userland, and # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. case "${UNAME_VERSION}" in Debian*) release='-gnu' ;; *) release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ;; esac # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} exit ;; *:ekkoBSD:*:*) echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} exit ;; *:SolidBSD:*:*) echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) echo powerpc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} exit ;; alpha:OSF1:*:*) case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on # OSF/1 and Tru64 systems produced since 1995. I hope that # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` case "$ALPHA_CPU_TYPE" in "EV4 (21064)") UNAME_MACHINE="alpha" ;; "EV4.5 (21064)") UNAME_MACHINE="alpha" ;; "LCA4 (21066/21068)") UNAME_MACHINE="alpha" ;; "EV5 (21164)") UNAME_MACHINE="alphaev5" ;; "EV5.6 (21164A)") UNAME_MACHINE="alphaev56" ;; "EV5.6 (21164PC)") UNAME_MACHINE="alphapca56" ;; "EV5.7 (21164PC)") UNAME_MACHINE="alphapca57" ;; "EV6 (21264)") UNAME_MACHINE="alphaev6" ;; "EV6.7 (21264A)") UNAME_MACHINE="alphaev67" ;; "EV6.8CB (21264C)") UNAME_MACHINE="alphaev68" ;; "EV6.8AL (21264B)") UNAME_MACHINE="alphaev68" ;; "EV6.8CX (21264D)") UNAME_MACHINE="alphaev68" ;; "EV6.9A (21264/EV69A)") UNAME_MACHINE="alphaev69" ;; "EV7 (21364)") UNAME_MACHINE="alphaev7" ;; "EV7.9 (21364A)") UNAME_MACHINE="alphaev79" ;; esac # A Pn.n version is a patched version. # A Vn.n version is a released version. # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` # Reset EXIT trap before exiting to avoid spurious non-zero exit code. exitcode=$? trap '' 0 exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead # of the specific Alpha model? echo alpha-pc-interix exit ;; 21064:Windows_NT:50:3) echo alpha-dec-winnt3.5 exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; *:[Aa]miga[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-amigaos exit ;; *:[Mm]orph[Oo][Ss]:*:*) echo ${UNAME_MACHINE}-unknown-morphos exit ;; *:OS/390:*:*) echo i370-ibm-openedition exit ;; *:z/VM:*:*) echo s390-ibm-zvmoe exit ;; *:OS400:*:*) echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; arm:riscos:*:*|arm:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) echo hppa1.1-hitachi-hiuxmpp exit ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. if test "`(/bin/universe) 2>/dev/null`" = att ; then echo pyramid-pyramid-sysv3 else echo pyramid-pyramid-bsd fi exit ;; NILE*:*:*:dcosx) echo pyramid-pyramid-svr4 exit ;; DRS?6000:unix:4.0:6*) echo sparc-icl-nx6 exit ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; s390x:SunOS:*:*) echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) echo i386-pc-auroraux${UNAME_RELEASE} exit ;; i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) eval $set_cc_for_build SUN_ARCH="i386" # If there is a compiler, see if it is configured for 64-bit objects. # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. # This test works for both compilers. if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null then SUN_ARCH="x86_64" fi fi echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:*:*) case "`/usr/bin/arch -k`" in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` exit ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${UNAME_RELEASE} exit ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 case "`/bin/arch`" in sun3) echo m68k-sun-sunos${UNAME_RELEASE} ;; sun4) echo sparc-sun-sunos${UNAME_RELEASE} ;; esac exit ;; aushp:SunOS:*:*) echo sparc-auspex-sunos${UNAME_RELEASE} exit ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor # > m68000). The system name ranges from "MiNT" over "FreeMiNT" # to the lowercase version "mint" (or "freemint"). Finally # the system name "TOS" denotes a system which is actually not # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) echo m68k-milan-mint${UNAME_RELEASE} exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) echo m68k-hades-mint${UNAME_RELEASE} exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) echo m68k-unknown-mint${UNAME_RELEASE} exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; powerpc:machten:*:*) echo powerpc-apple-machten${UNAME_RELEASE} exit ;; RISC*:Mach:*:*) echo mips-dec-mach_bsd4.3 exit ;; RISC*:ULTRIX:*:*) echo mips-dec-ultrix${UNAME_RELEASE} exit ;; VAX*:ULTRIX*:*:*) echo vax-dec-ultrix${UNAME_RELEASE} exit ;; 2020:CLIX:*:* | 2430:CLIX:*:*) echo clipper-intergraph-clix${UNAME_RELEASE} exit ;; mips:*:*:UMIPS | mips:*:*:RISCos) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #ifdef __cplusplus #include <stdio.h> /* for printf() prototype */ int main (int argc, char *argv[]) { #else int main (argc, argv) int argc; char *argv[]; { #endif #if defined (host_mips) && defined (MIPSEB) #if defined (SYSTYPE_SYSV) printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_SVR4) printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); #endif #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); #endif #endif exit (-1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`$dummy $dummyarg` && { echo "$SYSTEM_NAME"; exit; } echo mips-mips-riscos${UNAME_RELEASE} exit ;; Motorola:PowerMAX_OS:*:*) echo powerpc-motorola-powermax exit ;; Motorola:*:4.3:PL8-*) echo powerpc-harris-powermax exit ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) echo powerpc-harris-powermax exit ;; Night_Hawk:Power_UNIX:*:*) echo powerpc-harris-powerunix exit ;; m88k:CX/UX:7*:*) echo m88k-harris-cxux7 exit ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ [ ${TARGET_BINARY_INTERFACE}x = x ] then echo m88k-dg-dgux${UNAME_RELEASE} else echo m88k-dg-dguxbcs${UNAME_RELEASE} fi else echo i586-dg-dgux${UNAME_RELEASE} fi exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) echo m88k-tektronix-sysv3 exit ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) echo m68k-tektronix-bsd exit ;; *:IRIX*:*:*) echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` exit ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) echo i386-ibm-aix exit ;; ia64:AIX:*:*) if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} exit ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include <sys/systemcfg.h> main() { if (!__power_pc()) exit(1); puts("powerpc-ibm-aix3.2.5"); exit(0); } EOF if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` then echo "$SYSTEM_NAME" else echo rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then echo rs6000-ibm-aix3.2.4 else echo rs6000-ibm-aix3.2 fi exit ;; *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 else IBM_ARCH=powerpc fi if [ -x /usr/bin/oslevel ] ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} fi echo ${IBM_ARCH}-ibm-aix${IBM_REV} exit ;; *:AIX:*:*) echo rs6000-ibm-aix exit ;; ibmrt:4.4BSD:*|romp-ibm:BSD:*) echo romp-ibm-bsd4.4 exit ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) echo rs6000-bull-bosx exit ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit ;; 9000/[34]??:4.3bsd:1.*:*) echo m68k-hp-bsd exit ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) echo m68k-hp-bsd4.4 exit ;; 9000/[34678]??:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` case "${UNAME_MACHINE}" in 9000/31? ) HP_ARCH=m68000 ;; 9000/[34]?? ) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` case "${sc_cpu_version}" in 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 case "${sc_kernel_bits}" in 32) HP_ARCH="hppa2.0n" ;; 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 esac ;; esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #define _HPUX_SOURCE #include <stdlib.h> #include <unistd.h> int main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); #endif long cpu = sysconf (_SC_CPU_VERSION); switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0"); break; case CPU_PA_RISC1_1: puts ("hppa1.1"); break; case CPU_PA_RISC2_0: #if defined(_SC_KERNEL_BITS) switch (bits) { case 64: puts ("hppa2.0w"); break; case 32: puts ("hppa2.0n"); break; default: puts ("hppa2.0"); break; } break; #else /* !defined(_SC_KERNEL_BITS) */ puts ("hppa2.0"); break; #endif default: puts ("hppa1.0"); break; } exit (0); } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac if [ ${HP_ARCH} = "hppa2.0w" ] then eval $set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler # generating 64-bit code. GNU and HP use different nomenclature: # # $ CC_FOR_BUILD=cc ./config.guess # => hppa2.0w-hp-hpux11.23 # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | grep -q __LP64__ then HP_ARCH="hppa2.0w" else HP_ARCH="hppa64" fi fi echo ${HP_ARCH}-hp-hpux${HPUX_REV} exit ;; ia64:HP-UX:*:*) HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` echo ia64-hp-hpux${HPUX_REV} exit ;; 3050*:HI-UX:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #include <unistd.h> int main () { long cpu = sysconf (_SC_CPU_VERSION); /* The order matters, because CPU_IS_HP_MC68K erroneously returns true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct results, however. */ if (CPU_IS_PA_RISC (cpu)) { switch (cpu) { case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; default: puts ("hppa-hitachi-hiuxwe2"); break; } } else if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else puts ("unknown-hitachi-hiuxwe2"); exit (0); } EOF $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } echo unknown-hitachi-hiuxwe2 exit ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) echo hppa1.0-hp-mpeix exit ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) echo hppa1.1-hp-osf exit ;; hp8??:OSF1:*:*) echo hppa1.0-hp-osf exit ;; i*86:OSF1:*:*) if [ -x /usr/sbin/sysversion ] ; then echo ${UNAME_MACHINE}-unknown-osf1mk else echo ${UNAME_MACHINE}-unknown-osf1 fi exit ;; parisc*:Lites*:*:*) echo hppa1.1-hp-lites exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*[A-Z]90:*:*:*) echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*T3E:*:*:*) echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; CRAY*SV1:*:*:*) echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; *:UNICOS/mp:*:*) echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit ;; sparc*:BSD/OS:*:*) echo sparc-unknown-bsdi${UNAME_RELEASE} exit ;; *:BSD/OS:*:*) echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) UNAME_PROCESSOR=`/usr/bin/uname -p` case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; i*:MSYS*:*) echo ${UNAME_MACHINE}-pc-msys exit ;; i*:windows32*:*) # uname -m includes "-pc" on this system. echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; *:Interix*:*) case ${UNAME_MACHINE} in x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; IA64) echo ia64-unknown-interix${UNAME_RELEASE} exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; 8664:Windows_NT:*) echo x86_64-pc-mks exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we # UNAME_MACHINE based on the output of uname instead of i386? echo i586-pc-interix exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; p*:CYGWIN*:*) echo powerpcle-unknown-cygwin exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; *:GNU:*:*) # the GNU system echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` exit ;; *:GNU/*:*:*) # other systems with GNU libc and userland echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu exit ;; i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; aarch64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; aarch64_be:Linux:*:*) UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; alpha:Linux:*:*) case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; PCA57) UNAME_MACHINE=alphapca56 ;; EV6) UNAME_MACHINE=alphaev6 ;; EV67) UNAME_MACHINE=alphaev67 ;; EV68*) UNAME_MACHINE=alphaev68 ;; esac objdump --private-headers /bin/sh | grep -q ld.so.1 if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} exit ;; arm*:Linux:*:*) eval $set_cc_for_build if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_EABI__ then echo ${UNAME_MACHINE}-unknown-linux-gnu else if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_PCS_VFP then echo ${UNAME_MACHINE}-unknown-linux-gnueabi else echo ${UNAME_MACHINE}-unknown-linux-gnueabihf fi fi exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; hexagon:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; i*86:Linux:*:*) LIBC=gnu eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #ifdef __dietlibc__ LIBC=dietlibc #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m32r*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU #undef ${UNAME_MACHINE} #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; or32:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; padre:Linux:*:*) echo sparc-unknown-linux-gnu exit ;; parisc64:Linux:*:* | hppa64:Linux:*:*) echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in PA7*) echo hppa1.1-unknown-linux-gnu ;; PA8*) echo hppa2.0-unknown-linux-gnu ;; *) echo hppa-unknown-linux-gnu ;; esac exit ;; ppc64:Linux:*:*) echo powerpc64-unknown-linux-gnu exit ;; ppc:Linux:*:*) echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; tile*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; xtensa*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. echo ${UNAME_MACHINE}-pc-os2-emx exit ;; i*86:XTS-300:*:STOP) echo ${UNAME_MACHINE}-unknown-stop exit ;; i*86:atheos:*:*) echo ${UNAME_MACHINE}-unknown-atheos exit ;; i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) echo ${UNAME_MACHINE}-pc-msdosdjgpp exit ;; i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} else echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} fi exit ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} exit ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name` echo ${UNAME_MACHINE}-pc-isc$UNAME_REL elif /bin/uname -X 2>/dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else echo ${UNAME_MACHINE}-pc-sysv32 fi exit ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i586. # Note: whatever this is, it MUST be the same as what config.sub # prints for the "djgpp" host, or else GDB configury will decide that # this is a cross-build. echo i586-pc-msdosdjgpp exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; paragon:*:*:*) echo i860-intel-osf1 exit ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 fi exit ;; mini*:CTIX:SYS*5:*) # "miniframe" echo m68010-convergent-sysv exit ;; mc68k:UNIX:SYSTEM5:3.51m) echo m68k-convergent-sysv exit ;; M680?0:D-NIX:5.3:*) echo m68k-diab-dnix exit ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) OS_REL='' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4; exit; } ;; NCR*:*:4.2:* | MPRAS*:*:4.2:*) OS_REL='.3' test -r /etc/.relid \ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; mc68030:UNIX_System_V:4.*:*) echo m68k-atari-sysv4 exit ;; TSUNAMI:LynxOS:2.*:*) echo sparc-unknown-lynxos${UNAME_RELEASE} exit ;; rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) echo mips-dde-sysv${UNAME_RELEASE} exit ;; RM*:ReliantUNIX-*:*:*) echo mips-sni-sysv4 exit ;; RM*:SINIX-*:*:*) echo mips-sni-sysv4 exit ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says <Richard.M.Bartel@ccMail.Census.GOV> echo i586-unisys-sysv4 exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <hewes@openmarket.com>. # How about differentiating between stratus architectures? -djm echo hppa1.1-stratus-sysv4 exit ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. echo i860-stratus-sysv4 exit ;; i*86:VOS:*:*) # From Paul.Green@stratus.com. echo ${UNAME_MACHINE}-stratus-vos exit ;; *:VOS:*:*) # From Paul.Green@stratus.com. echo hppa1.1-stratus-vos exit ;; mc68*:A/UX:*:*) echo m68k-apple-aux${UNAME_RELEASE} exit ;; news*:NEWS-OS:6*:*) echo mips-sony-newsos6 exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then echo mips-nec-sysv${UNAME_RELEASE} else echo mips-unknown-sysv${UNAME_RELEASE} fi exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. echo powerpc-apple-beos exit ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; BePC:Haiku:*:*) # Haiku running on Intel PC compatible. echo i586-pc-haiku exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; SX-5:SUPER-UX:*:*) echo sx5-nec-superux${UNAME_RELEASE} exit ;; SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; SX-7:SUPER-UX:*:*) echo sx7-nec-superux${UNAME_RELEASE} exit ;; SX-8:SUPER-UX:*:*) echo sx8-nec-superux${UNAME_RELEASE} exit ;; SX-8R:SUPER-UX:*:*) echo sx8r-nec-superux${UNAME_RELEASE} exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; *:Rhapsody:*:*) echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} exit ;; *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in i386) eval $set_cc_for_build if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null then UNAME_PROCESSOR="x86_64" fi fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} exit ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = "x86"; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} exit ;; *:QNX:*:4*) echo i386-pc-qnx exit ;; NEO-?:NONSTOP_KERNEL:*:*) echo neo-tandem-nsk${UNAME_RELEASE} exit ;; NSE-?:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) echo nsr-tandem-nsk${UNAME_RELEASE} exit ;; *:NonStop-UX:*:*) echo mips-compaq-nonstopux exit ;; BS2000:POSIX*:*:*) echo bs2000-siemens-sysv exit ;; DS/*:UNIX_System_V:*:*) echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} exit ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. if test "$cputype" = "386"; then UNAME_MACHINE=i386 else UNAME_MACHINE="$cputype" fi echo ${UNAME_MACHINE}-unknown-plan9 exit ;; *:TOPS-10:*:*) echo pdp10-unknown-tops10 exit ;; *:TENEX:*:*) echo pdp10-unknown-tenex exit ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) echo pdp10-dec-tops20 exit ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) echo pdp10-xkl-tops20 exit ;; *:TOPS-20:*:*) echo pdp10-unknown-tops20 exit ;; *:ITS:*:*) echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; V*) echo vax-dec-vms ; exit ;; esac ;; *:XENIX:*:SysV) echo i386-pc-xenix exit ;; i*86:skyos:*:*) echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' exit ;; i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; i*86:AROS:*:*) echo ${UNAME_MACHINE}-pc-aros exit ;; x86_64:VMkernel:*:*) echo ${UNAME_MACHINE}-unknown-esx exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ # include <sys/types.h> # include <sys/utsname.h> #endif main () { #if defined (sony) #if defined (MIPSEB) /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, I don't know.... */ printf ("mips-sony-bsd\n"); exit (0); #else #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 "4" #else "" #endif ); exit (0); #endif #endif #if defined (__arm) && defined (__acorn) && defined (__unix) printf ("arm-acorn-riscix\n"); exit (0); #endif #if defined (hp300) && !defined (hpux) printf ("m68k-hp-bsd\n"); exit (0); #endif #if defined (NeXT) #if !defined (__ARCHITECTURE__) #define __ARCHITECTURE__ "m68k" #endif int version; version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; if (version < 4) printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); else printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); exit (0); #endif #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) printf ("ns32k-encore-sysv\n"); exit (0); #else #if defined (CMU) printf ("ns32k-encore-mach\n"); exit (0); #else printf ("ns32k-encore-bsd\n"); exit (0); #endif #endif #endif #if defined (__386BSD__) printf ("i386-pc-bsd\n"); exit (0); #endif #if defined (sequent) #if defined (i386) printf ("i386-sequent-dynix\n"); exit (0); #endif #if defined (ns32000) printf ("ns32k-sequent-dynix\n"); exit (0); #endif #endif #if defined (_SEQUENT_) struct utsname un; uname(&un); if (strncmp(un.version, "V2", 2) == 0) { printf ("i386-sequent-ptx2\n"); exit (0); } if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ printf ("i386-sequent-ptx1\n"); exit (0); } printf ("i386-sequent-ptx\n"); exit (0); #endif #if defined (vax) # if !defined (ultrix) # include <sys/param.h> # if defined (BSD) # if BSD == 43 printf ("vax-dec-bsd4.3\n"); exit (0); # else # if BSD == 199006 printf ("vax-dec-bsd4.3reno\n"); exit (0); # else printf ("vax-dec-bsd\n"); exit (0); # endif # endif # else printf ("vax-dec-bsd\n"); exit (0); # endif # else printf ("vax-dec-ultrix\n"); exit (0); # endif #endif #if defined (alliant) && defined (i860) printf ("i860-alliant-bsd\n"); exit (0); #endif exit (1); } EOF $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && { echo "$SYSTEM_NAME"; exit; } # Apollos put the system type in the environment. test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } # Convex versions that predate uname can use getsysinfo(1) if [ -x /usr/convex/getsysinfo ] then case `getsysinfo -f cpu_type` in c1*) echo c1-convex-bsd exit ;; c2*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi exit ;; c34*) echo c34-convex-bsd exit ;; c38*) echo c38-convex-bsd exit ;; c4*) echo c4-convex-bsd exit ;; esac fi cat >&2 <<EOF $0: unable to guess system type This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be pertinent to <config-patches@gnu.org> in order to provide the needed information to handle your system. config.guess timestamp = $timestamp uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` /bin/uname -X = `(/bin/uname -X) 2>/dev/null` hostinfo = `(hostinfo) 2>/dev/null` /bin/universe = `(/bin/universe) 2>/dev/null` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` /bin/arch = `(/bin/arch) 2>/dev/null` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` UNAME_MACHINE = ${UNAME_MACHINE} UNAME_RELEASE = ${UNAME_RELEASE} UNAME_SYSTEM = ${UNAME_SYSTEM} UNAME_VERSION = ${UNAME_VERSION} EOF exit 1 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "timestamp='" # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/src/Makefile.in�����������������������������������������������������������������������0000755�0001750�0001750�00000015400�13021361015�014151� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# MAIN MAKEFILE # ------------- ROOT_DIR = @ROOT_DIR@ PKG_NAME = @PKG_NAME@ INSTALL_DIR = $(DESTDIR)@INSTALL_DIR@ LINKS_DIR = $(DESTDIR)@LINKS_DIR@ DOC_DIR = $(DESTDIR)@DOC_DIR@ HTML_DIR = $(DESTDIR)@HTML_DIR@ EXAMPLES_DIR = $(DESTDIR)@EXAMPLES_DIR@ TXT_FILES = @TXT_FILES@ BIN_FILES = @BIN_FILES@ OBJ_FILES = @OBJ_FILES@ LIB_FILES = @LIB_FILES@ INC_FILES = @INC_FILES@ DOC_FILES = @DOC_FILES@ HTML_FILES = @HTML_FILES@ EXPL_FILES = @EXPL_FILES@ EXC_FILES = @EXC_FILES@ EXFD_FILES = @EXFD_FILES@ INSTALL = @INSTALL@ INSTALL_PROGRAM= @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ TOP_LEVEL = @TOP_LEVEL@ LN_S = @LN_S@ -f RANLIB = @RANLIB@ LE_DIRS = Linedit W32GC_DIRS = W32GUICons FD_DIRS = Fd2C EngineFD BipsFD SUB_DIRS = EnginePl TopComp Wam2Ma Ma2Asm @MAKE_LE_DIRS@ @MAKE_W32GC_DIRS@ \ BipsPl Pl2Wam @MAKE_FD_DIRS@ SUB_DIRS_ALL = EnginePl TopComp Wam2Ma Ma2Asm $(LE_DIRS) $(W32GC_DIRS) \ BipsPl Pl2Wam $(FD_DIRS) # --- COMPILE --- # all: config . ./SETVARS;for i in $(SUB_DIRS);do (cd $$i; $(MAKE)) || exit 1; done;\ (cd TopComp; $(MAKE) top-level) || exit 1;\ (cd Pl2Wam; $(MAKE) stage2) # config mainly creates gplc needed by other Makefiles (so we can use make -j) config: cd EnginePl; $(MAKE) config # --- INSTALL --- # install-strip: $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install install: install-system install-doc install-html install-examples install-links install-system: ./mkinstalldirs $(INSTALL_DIR) $(INSTALL_DIR)/bin \ $(INSTALL_DIR)/include $(INSTALL_DIR)/lib for i in $(TXT_FILES); do $(INSTALL_DATA) ../$$i $(INSTALL_DIR); done for i in $(BIN_FILES); do $(INSTALL_PROGRAM) */$$i $(INSTALL_DIR)/bin; done for i in $(OBJ_FILES); do $(INSTALL_DATA) */$$i $(INSTALL_DIR)/lib; done for i in $(LIB_FILES); do $(INSTALL_DATA) */$$i $(INSTALL_DIR)/lib; done for i in $(INC_FILES); do EnginePl/cpp_headers $$i ./$$i EnginePl EngineFD BipsPl BipsFD; $(INSTALL_DATA) ./$$i $(INSTALL_DIR)/include; rm -f $$i; done (cd $(INSTALL_DIR)/lib; for i in *.a; do $(RANLIB) $$i; done) uninstall: uninstall-links uninstall-html uninstall-doc uninstall-examples for i in $(BIN_FILES); do rm -f $(INSTALL_DIR)/bin/$$i; done rmdir -p $(INSTALL_DIR)/bin 2>/dev/null || exit 0 for i in $(LIB_FILES) $(OBJ_FILES); do rm -f $(INSTALL_DIR)/lib/$$i; done rmdir -p $(INSTALL_DIR)/lib 2>/dev/null || exit 0 for i in $(INC_FILES); do rm -f $(INSTALL_DIR)/include/$$i; done rmdir -p $(INSTALL_DIR)/include 2>/dev/null || exit 0 for i in $(TXT_FILES); do rm -f $(INSTALL_DIR)/$$i; done rmdir $(INSTALL_DIR) 2>/dev/null || exit 0 # --- Links --- # install-links: uninstall-links if test $(LINKS_DIR) != none; then \ ./mkinstalldirs $(LINKS_DIR); \ (cd $(LINKS_DIR) ; $(LN_S) $(INSTALL_DIR)/bin/* .); \ fi uninstall-links: -if test $(LINKS_DIR) != none; then \ (cd $(LINKS_DIR) 2>/dev/null && rm -f $(BIN_FILES)); \ rmdir $(LINKS_DIR) 2>/dev/null; \ fi || exit 0; # --- Documentation --- # install-doc: if test $(DOC_DIR) != none; then \ ./mkinstalldirs $(DOC_DIR); \ (F=`cd ../doc; echo $(DOC_FILES)`; \ for i in $$F; do $(INSTALL_DATA) ../doc/$$i $(DOC_DIR); done); \ fi uninstall-doc: -if test $(DOC_DIR) != none; then \ (cd $(DOC_DIR); rm -f $(DOC_FILES)); \ rmdir $(DOC_DIR) 2>/dev/null; \ fi || exit 0; # --- HTML --- # install-html: if test $(HTML_DIR) != none; then \ ./mkinstalldirs $(HTML_DIR); \ (F=`cd ../doc/html_node; echo $(HTML_FILES)`; \ for i in $$F; do $(INSTALL_DATA) ../doc/html_node/$$i $(HTML_DIR); done); \ fi uninstall-html: -if test $(HTML_DIR) != none; then \ (cd $(HTML_DIR); rm -f $(HTML_FILES)); \ rmdir $(HTML_DIR) 2>/dev/null; \ fi || exit 0; # --- Examples --- # install-examples: if test $(EXAMPLES_DIR) != none; then \ ./mkinstalldirs $(EXAMPLES_DIR)/ExamplesPl; \ (F=`cd ../examples/ExamplesPl; echo $(EXPL_FILES)`; \ for i in $$F; do $(INSTALL_DATA) ../examples/ExamplesPl/$$i $(EXAMPLES_DIR)/ExamplesPl; done); \ ./mkinstalldirs $(EXAMPLES_DIR)/ExamplesC; \ (F=`cd ../examples/ExamplesC; echo $(EXC_FILES)`; \ for i in $$F; do $(INSTALL_DATA) ../examples/ExamplesC/$$i $(EXAMPLES_DIR)/ExamplesC; done); \ ./mkinstalldirs $(EXAMPLES_DIR)/ExamplesFD; \ (F=`cd ../examples/ExamplesFD; echo $(EXFD_FILES)`; \ for i in $$F; do $(INSTALL_DATA) ../examples/ExamplesFD/$$i $(EXAMPLES_DIR)/ExamplesFD; done); \ fi uninstall-examples: rm -rf $(EXAMPLES_DIR)/ExamplesPl rm -rf $(EXAMPLES_DIR)/ExamplesC rm -rf $(EXAMPLES_DIR)/ExamplesFD -rmdir $(EXAMPLES_DIR) 2>/dev/null || exit 0 # --- CHECKS --- # check: . ./SETVARS; \ (cd EnginePl; $(MAKE) check) && \ (cd Ma2Asm; $(MAKE) check) && \ (cd Pl2Wam; $(MAKE) check) && \ (cd BipsPl; $(MAKE) check) && \ echo All tests succeeded # --- CLEAN --- # RUN_PL_DIRS = EnginePl BipsPl RUN_FD_DIRS = EngineFD BipsFD RUN_SUB_DIRS= $(RUN_PL_DIRS) $(RUN_PL_DIRS) clean: for i in $(SUB_DIRS_ALL); do (cd $$i; $(MAKE) clean); done clean-pl: for i in $(RUN_PL_DIRS); do (cd $$i; $(MAKE) clean); done clean-fd: for i in $(RUN_FD_DIRS); do (cd $$i; $(MAKE) clean); done clean-pl-fd: clean-pl clean-fd distclean: rm -rf config.status config.log config.cache autom4te.cache for i in $(SUB_DIRS_ALL); do (cd $$i; $(MAKE) distclean); done # --- DISTRIBUTION --- # distdir=/tmp distpath=$(distdir)/$(PKG_NAME) dist: check_doc $(PKG_NAME).tar.gz check_doc: (cd ../doc; make all) $(PKG_NAME).tar.gz: copy_dist_tree (cd $(distdir); tar cf $(ROOT_DIR)/src/$(PKG_NAME).tar $(PKG_NAME)) gzip -f $(PKG_NAME).tar -rm -rf $(distpath) @banner="$(PKG_NAME).tar.gz is ready for distribution"; \ dashes=`echo "$$banner" | sed s/./=/g`; \ echo "$$dashes"; \ echo "$$banner"; \ echo "$$dashes" # below we use 2 cd in case distpath is not an absolute path like '.' copy_dist_tree: -rm -rf $(distpath) mkdir -p $(distpath) while read f;do files="$$files $$f"; done <DISTRIB_FILES; \ (cd ..;tar cf - $$files | (cd $(ROOT_DIR)/src;cd $(distpath); tar xf -)) old$(PKG_NAME).tar.gz: -rm -rf $(distpath) mkdir $(distpath) -chmod 777 $(distpath) (while read f; do \ if [ x$$f != x ]; then \ subdir=`dirname $$f`; \ if test "$$subdir" = .; then :; else \ test -d $(distpath)/$$subdir \ || mkdir -p $(distpath)/$$subdir \ || exit 1; \ chmod 777 $(distpath)/$$subdir; \ fi; \ cp -pr ../$$f $(distpath)/$$subdir; \ fi; \ done <DISTRIB_FILES) tar cf $(PKG_NAME).tar $(distpath) gzip -f $(PKG_NAME).tar -rm -rf $(distpath) @banner="$(PKG_NAME).tar.gz is ready for distribution"; \ dashes=`echo "$$banner" | sed s/./=/g`; \ echo "$$dashes"; \ echo "$$banner"; \ echo "$$dashes" ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/RELEASE_DATES�������������������������������������������������������������������������0000644�0001750�0001750�00000001430�13021324543�013240� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������1.4.5 (Dec 2014) 1.4.4 (Apr 2013) 1.4.3 (Mar 2013) 1.4.2 (Dec 2012) 1.4.1 (Jun 2012) 1.4.0 (Jul 2011) 1.3.1 (Feb 2009) 1.3.0 (Jan 2007) 1.2.19 (Jun 2005) 1.2.18 (Jun 2004) 1.2.17 (Feb 2003) 1.2.16 (Sep 2002) 1.2.15 (Sep 2002) 1.2.14 (Jun 2002) 1.2.13 (Jun 2002) 1.2.12 (Apr 2002) 1.2.11 (Mar 2002) 1.2.10 (Jan 2002) 1.2.9 (Dec 2001) 1.2.8 (Oct 2001) 1.2.7 (Sep 2001) 1.2.6 (Jan 2001) 1.2.5 (Dec 2000) 1.2.4 (Nov 2000) 1.2.3 (Sep 2000) 1.2.2 (Sep 2000) 1.2.1 (Jul 2000) 1.2.0 (Jul 2000) 1.1.7 (Jul 2000) 1.1.6 (Jun 2000) 1.1.5 (Mar 2000) 1.1.4 (Jan 2000) 1.1.3 (Dec 1999) 1.1.2 (Nov 1999) 1.1.1 (Oct 1999) 1.1.0 (Oct 1999) 1.0.6 (Sep 1999) 1.0.5 (Jul 1999) 1.0.4 (Jul 1999) 1.0.3 (Jun 1999) 1.0.2 (Jun 1999) 1.0.1 (Jun 1999) 1.0.0 (Apr 1999) 0.9.0 (Mar 1999) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/NEWS����������������������������������������������������������������������������������0000644�0001750�0001750�00000055746�13021324543�012037� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Change in GNU Prolog version 1.4.5 (April 2014): * fix a bug in findall/4 * fix a bug in select/5 under Windows * fix a bug in the compiler * fix a bug in read/1 * fix large address awarenes under cygwin32 (configure.in) * improve memory limitation of acyclic_term/1 * improve term output (write/1 and friends) * improve error handling for options (e.g. in write_term/3) * fix bug with cut in the if-part of if-then(-else) * fix port to x86_64/OpenBSD (machine kindly provided by Duncan Patton a Campbell) * fix a bug with Apple/Yosemite gcc = LLVM version 6.0 (clang-600.0.56) on x86_64 * allow to define more atoms with MAX_ATOM env var on 64 bits machines * fix a bug in bagof/3 when used as findall/3 * port to sparc64/OpenBSD (machine kindly provided by Duncan Patton a Campbell) * add built-in predicate findall/4 * fix a bug with linedit when environment variable LINEDIT=no * fix bugs in the FD solver * set socket option SO_REUSEADDR at socket creation * support for alternate Prolog file extension .prolog * fix a bug in atoms for 1-char atom '\0' (now acts as the empty atom) * fix problems with Apple/Mavericks gcc = LLVM version 5.0 (clang-500.2.79) on x86_64 * remove clang warnings (uninitialized variables) * fix bugs in the lexer of the form 0bop 2 when bop is an infix op * fix terminal ANSI sequence handling in linedit * increase internal compiler data sizes * fix bug in gprolog.h (invalid 64 bits PL_MAX_INTEGER) Change in GNU Prolog version 1.4.4 (Apr 2013): * add Prolog flags c_cc_version_data * fix a regression bug in linedit * fix a little bug in the debugger * add subtract/3 built-in predicate Change in GNU Prolog version 1.4.3 (Mar 2013): * add new C foreign interface functions converting term to/from C strings * modify top-level banner to show 32/64 bits, compile date, C compiler name * modify Linedit: fix Prolog prompt when Linedit is not activated * modify linedit: accept gui=silent in env var LINEDIT (does not warn if the windows gui DLL is not found) * fixes for Windows 8 (i686 and x86_64) with MSVS 2012, mingw64 gcc > 4.5.3 * add Prolog flags address_bits, compiled_at, c_cc, c_cflags, c_ldflags * fix a bug in the FD solver (option backtracks in fd_labeling) * improve the FD solver (better propagation for reified constraints at labeling) * improve the FD solver (add labeling option: value_method(bisect)) * improve the FD solver (avoid some cases of C stack overflow, improved fd_domain/3) * fix another bug in the FD solver (regression bug in 1.4.2) * add PlULong to gprolog.h and PlThrow(ball) to C foreign interface * fix a bug in the FD solver (regression bug in 1.4.2) Change in GNU Prolog version 1.4.2 (Dec 2012): * fix a bug in the compiler for byte-code with op/3 directive * fix a bug in the debugger * modify decompose_file_name/4 (fix problems under windows) * add built-in is_absolute_file_name/1 and is_relative_file_name/1 * modify the compiler include/1 directive handling (if the file to include is not found, search in directories of parent includers) * modify atom table management (its size can be defined via env. var MAX_ATOM) * fix a bug with soft-call inside a meta-call * implement term_hash/2 and term_hash/4. Backward incompatibility: new_atom/3 and and atom_hash/2 no longer exists. * fix some little bugs with 64 bits (e.g. stream id) * modify the FD solver to handle very long computations * fix a bug in the compiler (unification with fresh vars in the body) * fix a bug with *-> containing ! in the test part (! was not local to the test) * fix a bug to configure with sigaction on old Linux kernels * fix some problems/bugs on 64 bits machine Change in GNU Prolog version 1.4.1 (Jun 2012): * improve signal handling * add an option --wam-comment to gplc and pl2wam * fix multifile directive (works now with an empty predicate as required by ISO) * fix absolute_file_name to expand ~ using HOMEDRIVE and HOMEPATH under windows if HOME is not defined * improve listing/0-1 output * add soft cut control construct and its associated operator *-> * improve the top-level results in case of cyclic terms * fix arithmetic evaluable functor ^/2 to work with floats * increase maximum number of variables in a term * add write_term option variable_names * add built-in predicates between/3 and succ/2 * fix bug in the DCG expander * fix bug in member/2 * recognize escape sequence \s (space) and \e (escape) if strict_iso is off * add error detection in length/2 if given length is negative * add built-in predicates maplist/2-9 * fix a regression bug in the FD solver about sparse domains * increase size of FD internal stacks and fix memory leak * port to x86_64/Darwin (Mac OS X) - many thanks to Ozaki Kiichi <gclient.gaap@gmail.com> * fix a bug in x86_64 with --disable-regs * fix a bug when consulting a file under Win XP/Vista 32 bits * fix a bug when consulting a file using '$VAR'(N) or '$VARNAME'(A) * fix a bug in new_atom/1-2 which returned duplicates * fix a bug in write/1 when an empty atom is passed * improve portray_clause (numbervars and space before final dot) Change in GNU Prolog version 1.4.0 (Jul 2011): * GNU Prolog is now licensed under a dual license LGPL or GPL * port to x86_64/MinGW64 - many thanks to Jasper Taylor <jasper@simulistics.com> (see src/WINDOWS64) * port to x86_64/MSVC (see src/WINDOWS64) * add a configure option to control Windows HtmlHelp --disable-htmlhelp or --enable-htmlhelp[=static/dynamic] * improve a lot (and fix some bugs in) the Windows GUI Console * change location of gprologvars.bat under Windows (in install directory) * increase default stack sizes (32Mb for heap, 16Mb for others) * change the default setting for flag strict_iso: it is on now * add control constructs to the predicate table * modify predicate_property/2 (built_in_fd ==> built_in, add control_construct) only accepts a Head (a callable) (no longer a predicate indicator) * fix a bug in the compiler (bad unification with singleton variable) * fix a bug with strict_iso flag (was not passed to consult) * add shebang support using #!/usr/bin/gprolog --consult-file * modify the mangling scheme for future module support (see hexgplc) * fix write_term default options (now numbervars(false) and namevars(false)) * fix read/1: tab and newlines are not accepted inside single/back/double quoted tokens * add additional errors to compare/3 and keysort/2 * accept space under the top-level (same as ;) * modify portray_clause/1-2 to add a newline at the end of the output * add acyclic_term/1 (compatibility only since GNU Prolog does not handle cyclic terms) * fix write/1 to treat '$VARNAME'(Atom) as a var name only if Atom is a valid var name * rename evaluable functor atan/2 as atan2/2 and >< as xor * add evaluable functor div/2 * detect op/3 error cases for | [] {} * replace type_error(variable, X) by uninstantiation_error(X) (e.g. open/3-4) * add built-in term_variables/2-3 and subsumes_term/2 * add some type tests on chars and codes (in number_chars/2, number_codes/2,..) * fix some little bugs in the parser * add meta_predicate property to predicate_property/2 * fix a memory leak in atom_concat/3 (in case of failure) * add infix operator '|' (and allow it to be unquoted in read/write) * improve top-level variables display adding () when needed * fix a bug in length/2 (length(L,L) now loops) * support the ISO multifile/1 directive * add built-ins false/0 and forall/2 * detect an instantiation_error in phrase/2-3 * GNU Prolog is now licensed under LGPL * allow rounding functions to accept an integer if strict_iso is off * group all examples under a new directory 'examples' * fix a bug in read_from_codes/2 and number_codes/2 * improve speed of built-in predicates on list (append, member, reverse,...). * improve CTRL+C handling under the top-level * add is_list/1 (same as list/1) * add Prolog flags: dialect, home, host_os, host_vendor, host_cpu, host, arch, version, version_data, unix, argv * add preprocessor directives if/1 else/0 elif/1 endif/0 * fix a bug on large ints in the byte-code for 64-bits machine * fix a bug with call/2-N * change listing/0-1 printing stream: now it is current_output * add a new stream alias: user_error associated to stderr * add evaluable functors: (a)sinh/1, (a)cosh/1, (a)tanh/1 * add evaluable functors: epsilon/0, lsb/1, msb/1, popcount/1 * fix compilation problem under Mac OS X Snow Leopard (force 32-bits mode) * add evaluable functors: log/2, gcd/2, tan/1, atan2/2, pi/0, e/0 * add built-in ground/1 * rename built-in sort0 as msort * add new error detection for keysort * accept (but ignore) directive encoding/1 * add xor/2 operator (bitwise XOR) ^/2 becomes integer exponentiation * improve randomize/0 (more different values on consecutive calls) * relax the lexer to also accept 0'' (ISO requires 0''' or 0'\') if strict_iso is off * fix a bug with top-level options --entry-goal and --query-goal Change in GNU Prolog version 1.3.1 (Feb 2009): * add working sigaction detection to detect fault addr (e.g. Mac OS X) * add gplc option --no-mult-warn * add prolog flags suspicious_warning, multifile_warning * detect integer underflow/overflow in the parser * fix a memory leak in catch/3 * increase limits (MAX_VAR_NAME_LENGTH=1024 and MAX_VAR_IN_TERM=10240) * add PL_INT_LOWEST_VALUE and PL_INT_GREATEST_VALUE to gprolog.h * prefix all global symbols, constants and types with Pl_ PL_ Pl * fix a bug in the byte-code due to new max number of atoms * provide a minimal gprolog.h * detect if struct sigcontext needs asm/sigcontext.h on Linux * modify gplc: --c-compiler also sets linker and --linker added * port to x86_64/BSD - many thanks to David Holland <dholland@netbsd.org> * fix problem using ebx as global reg (bug in gcc 4.3.2) * fix a bug in is/2 with [X] (X should only be an integer) * fix a bug with atoms '/*' '*/' and '%' (were not quoted) * increase maximum number of atoms to 1048576 (2^20) * increase default stack sizes (16Mb for heap, 8Mb for others) * fix stack alignment for x86_64/Solaris * include patch from Paul Eggert <eggert@cs.ucla.edu> for sparc/solaris8 * port to x86_64/Solaris - many thanks to Scott L. Burson <Scott@coral8.com> * fix a bug in the FD solver (under 64 bits machines) * fix a bug in arithmetics (mod) Change in GNU Prolog version 1.3.0 (Jan 2007): * change error messages emitted by the compiler to follow GNU standards * modify doc (mainly rename manual.xxx to gprolog.xxx) * add DESTDIR variable support in main Makefile for staged installs * fix a bug with Prolog floats in x86_64/Linux (bad stack alignment) * port for ix86/Darwin (Mac OS X) * add check target to main Makefile * improve Win32 ports (Cygwin, MinGW, MSVC 6.0 and 2005 Express Edition) (MSVC port uses MinGW as.exe instead of nasm.exe - named mingw-as.exe provided in the setup.exe) * rename call/2 to call_det/2 * implement call/2-11 as will be defined in the next standard * fix various problems when compiling with gcc 4 (gcc 4.1.1) * emit .note.GNU-stack to mark the stack as no executable in x86_any.c, x86_64_any.c and powerpc_any.c * change the way objects are found (obj_chain.c) using gcc ctors * use Doug Lea malloc for OpenBSD (problem with malloc using mmap) * fix problems in various ports: alpha/Linux, powerpc/Darwin (Mac OS X), sparc/solaris, ix86/OpenBSD Change in GNU Prolog version 1.2.19 (Jun 2005): * fix 2 bugs in global variables Change in GNU Prolog version 1.2.18 (Jun 2004): * fix problem when compiling with gcc 3.4.0 * fix bug in term comparison involving negative integers * add consult, ... and fix minor bugs in the Win32 GUI console menu * fix the stack overflow detection under Cygwin * port to ix86/MinGW - many thanks to Cesar Rabak <csrabak@ig.com.br> * fix a bug in the port to sparc/solaris * fix a problem in the port to x86/OpenBSD * port to sparc/NetBSD and powerpc/NetBSD - many thanks to Jason Beegan <jtb@netbsd.org> * fix a bug in =../2 involving FD variables * fix a bug in arithmetics (in float_{integer/fractional}_part) * fix a bug in FD solver (wrong union with a singleton) * fix a bug with the foreign C interface Change in GNU Prolog version 1.2.17 (Feb 2003): * change configure.in: by default ebp is not used * fix a but with CTRL+C handler not reinstalled * fix a bug with _XXX (re)displayed under the top-level * port to x86_64/Linux - many thanks to Gwenole Beauchesne <gbeauchesne@mandrakesoft.com> Change in GNU Prolog version 1.2.16 (Sep 2002): * fix bug in predicate_property/2 * add new built-in fork_prolog/1 and create_pipe/2 * fix a bug in atom_concat/3 * fix bug when detecting if a stream can be repositioned Change in GNU Prolog version 1.2.15 (Sep 2002): * fix bug in output to constant terms (e.g. write_to_atom/2) * include another additional patch for sockets under win32 - due to Brent Fulgham <brent.fulgham@xpsystems.com> * fix bug in bagof/3 with FD variables * fix bug with randomize/0 Change in GNU Prolog version 1.2.14 (Jun 2002): * added min/max to Prolog arithmetics * fix bugs in current_predicate and predicate_property Change in GNU Prolog version 1.2.13 (Jun 2002): * port to powerpc/Darwin (Mac OS X) - many thanks to Lindsey Spratt <spratt@alum.mit.edu> * fix bug in Win32 GUI console (deal with edit control text limit) * fix bug with in-place installation procedure * fix problem with portray_clause/2 using $VARNAME and $VAR now portray_clause((p(Z):-p('$VARNAME'('A'),Z))) is OK * fix bug with stream buffering (open/4 and set_stream_buffering/2) * add stream mirror facility (see add_stream_mirror/2) Change in GNU Prolog version 1.2.12 (Apr 2002): * improve global vars (arg. selector, automatic array, new built-ins) * fix two bugs with Ctrl+C reentrancy under the top-level * added priority/1 option to write_term to specify starting priority * now under the top-level, _XXX variables are not displayed * fix bug in decompose_file_name/4 (tried to modify read-only string) * now open/4 better detects if a stream can be repositioned * add source reader facility (built-in) - not yet documented * fix current_predicate bug, now current_predicate(nl/0) fails * fix linedit bug in tab pasting and add Esc-Tab function * now linedit goes to EOL at CR to fix bug with multi-line inputs * now linedit avoids to put in history 2 same consecutive lines * remove max_stream limitation (the Prolog flag no longer exists) * the template of get_print_stream/1 is now ?stream * patch to allow more than 64Mb for the stacks under ix86/Linux * fix a bug in wam2ma (hexa name creation overflowed malloc buffer) Change in GNU Prolog version 1.2.11 (Mar 2002): * fix a problem under sparc/solaris using mmap (adding MAP_FIXED) * fix a problem with gcc 3.0.x which always uses ebp in main() * use -march=xxx gcc option instead of -mxxx for ix86 Change in GNU Prolog version 1.2.10 (Jan 2002): * gplc now passes -L option to ld in the order of apparition * gplc accepts meta-characters %p, %d,... in output file names * include additional patch for sockets under win32 - due to Brent Fulgham <brent.fulgham@xpsystems.com> Change in GNU Prolog version 1.2.9 (Dec 2001): * re-write Windows GUI Console in pure Win32 (no more MFC) * adapt configure.in to work with autoconf 2.52 * add Prolog flag back_quotes and values {atom,chars,codes}_no_escape * use a terminal recursion in FD arithmetic normalization * fix bug in bind_variables/2, reported by: Bowie Owens <owe043@phi-cq.vic.cmis.csiro.au> * modify Ma2Asm mappers to use Y_OFFSET (from ENVIR_STATIC_SIZE) * fix some bugs in the Wam debugger * add several options to the top-level to execute goals * add an environment variable LINEDIT to control linedit options * fix bug in linedit on \b in start of line (using ANSI ESC sequences) * simplify linedit: only apply to stdin * now linedit is reentrant * now linedit works with XFree keyboard encoding * rename built-in get_code_no_echo/1-2 by get_key_no_echo/1-2 * add built-in get_key/1-2 * use get_key/1-2 in the top_level + debugger (thus with echo) * improve the top-level Ctrl+C manager * fix bug on Linux configured with --disable-regs * add pipe to pl2wam stdin when called by consult/1 * fix bug in FD: forall is now recognized in .fd files * fix bug in DCG: expand_term((a --> X), Y) is OK * fix X paste problem in linedit * simplify top_comp.c to better control include dirs in devel. mode * specialized functions for create/update/delete choice points * fix a bug in wam2ma (hexa name creation overflowed malloc buffer) * include patch to support basic sockets under win32 - due to Brent Fulgham <brent.fulgham@xpsystems.com> * arithmetic functions and inlined built-ins use fast call * specialized functions for switch_on_term_xxx * modify pl2wam to generalize '$call_c' (add options) Change in GNU Prolog version 1.2.8 (Oct 2001): * fix bug - delete file created by mkstemp(2), patch from: Salvador Abreu <spa@debian.org> * space_args(true) now displays a space inside {}/1 * space_args(true) now displays a space after a comma (','/2) Change in GNU Prolog version 1.2.7 (Sep 2001): * add a --foreign-only option to pl2wam * foreign/2 directives are ignored in byte-code mode (no fatal error) * space_args(true) now displays space between operators and arguments * add CVS Id to prolog files * fix bug in pl2wam to include break/0, trace/0,... in bip_list.pl * get rid of mktemp and tempnam calls (use mkstemp if available) * fix a bug in fd_element_var/3 constraint * fix bug in fd headers (fd_to_c.h not installed) * fix a bug with unify_with_occurs_check/2 * fix bug on ix86 using ebp (add -fomit-frame-pointer in CFLAGS_MACHINE) Change in GNU Prolog version 1.2.6 (Jan 2001): * fix a bug with ! in dynamic code * fix a bug in arithmetics Change in GNU Prolog version 1.2.5 (Dec 2000): * big modification (1 month) to optimize the execution speed Change in GNU Prolog version 1.2.4 (Nov 2000): * implement fast call (mainly for WAM functions) * modify C->Prolog foreign interface to recover arguments space * improve dynamic clause management and fix a bug (memory leak) * fix _ symbol prefix problem for Free BSD * no longer use dl_malloc on Linux but prevent MMAP using mallopt Change in GNU Prolog version 1.2.3 (Sep 2000): * full re-indentation of the sources for CVS * added acos/asin to Prolog arithmetics Change in GNU Prolog version 1.2.2 (Sep 2000): * port to alpha/Linux - many thanks to Alexander Diemand <ax@apax.net> * port to alpha/OSF1 * port to mips/irix - many thanks to Alexander Diemand <ax@apax.net> * fix a bug in stty.c (use standard termios if present) Change in GNU Prolog version 1.2.1 (Jul 2000): * fix a bug in stty.c (use termio by default and else termios) Change in GNU Prolog version 1.2.0 (Jul 2000): * more customizable configuration/installation procedure Change in GNU Prolog version 1.1.7 (Jul 2000): * port for ix86/NetBSD - many thanks to Brook Milligan <brook@nmsu.edu> Change in GNU Prolog version 1.1.6 (Jun 2000): * rename configuration file config.h by gp_config.h * avoid to establish a connection at start to get the hostname * fix a bug in the compiler about \\ inside quoted atoms * fix a bug in dynamic clause retraction (memory leak) * fix a bug in atom management (existing atoms eat mallocated space) * added creation/1 and last_access/1 property to file_property/2 * start of native Win32 port Change in GNU Prolog version 1.1.5 (Mar 2000): * port for ix86/FreeBSD - many thanks to Nicolas Ollinger <nollinge@ens-lyon.fr> Change in GNU Prolog version 1.1.4 (Jan 2000): * fix a bug in the byte-code loader (bad realloc computation) * fix a bug in the malloc (used MMAP under Linux) Change in GNU Prolog version 1.1.3 (Dec 1999): * port for ix86/SCO - many thanks to Clive Cox <clive@laluna.demon.co.uk> and Edmund Grimley Evans <edmundo@rano.demon.co.uk> * port for ix86/solaris - many thanks to Andreas Stolcke <stolcke@speech.sri.com> * fix a bug in the FD solver for X#\=C (if C is max(X)) * fix a bug with directory_files/2 (too many open files) Change in GNU Prolog version 1.1.2 (Nov 1999): * fix a bug in the compiler about \t in quoted atoms * fix a bug in the scanner about 0'<character> Change in GNU Prolog version 1.1.1 (Oct 1999): * fix bug with popen/3 * update machine.c for struct sigcontext under Linux Change in GNU Prolog version 1.1.0 (Oct 1999): * fix a bug in the output of some extended characters in native-compilation Change in GNU Prolog version 1.0.6 (Sep 1999): * implementation of call_with_args * fix a bug in sign/1 for arithmetic evaluation Change in GNU Prolog version 1.0.5 (Jul 1999): * fix a bug in foreign C calling Prolog on sparc Change in GNU Prolog version 1.0.4 (Jul 1999): * fix a bug in sparc compilation * fix a bug in foreign code under sparc * update pl_config.c to show which version is installed Change in GNU Prolog version 1.0.3 (Jun 1999): * add linedit test to avoid to re-echo an already buffered full-line * fix bugs is sort/1 * fix bug in sleep/1 (incorrect behavior with a float) * finish preliminary port to Cygwin (see file src/PROBLEMS) * fix bug in FD solver (too much trail allocated due to bad vec_size) * fix labeling first-fail to correspond to clp(FD) * fix message from consult when pl2wam cannot be found Change in GNU Prolog version 1.0.2 (Jun 1999): * fix precision bug on floating constants Change in GNU Prolog version 1.0.1 (Jun 1999): * initial port for ix86/Cygwin (Win32) (to finish) * fix bug in throw_c.c (foreign code catch exception) * improve Ma2Asm check.c and FromC/ utilities * port for PowerPC / GNU/Linux (see file src/PROBLEMS) * fix bug using egcs-1.1.2 (RedHat 6.0) (add a Stop_Prolog() fct) * removed Configure directory (clashes with ./configure under WinXX) * fix Linedit/Makefile.in (CFLAGS added) * add ensure_linked directive * fix bug in gplc help (-C/-A/-L instead of --C/--A/--L) * fix bug in gplc (with too long command-lines) * fix bug in M_Absolute_Path_Name() (/.automount gave /automount) * work release 1.0.1 * fix bug --disable-regs works now for solaris * optimize FD equations (math_supp.c) avoid qsort sometimes * fix bug in installation procedure (Html doc installation) Change in GNU Prolog version 1.0.0 (Apr 1999): * rewrite in C DCG translation: optimize unifications, no more ill-balanced conjunctions * fix bug in bc_supp.c to avoid aux pred name for unknown predicate * fix bug in pl2wam (:- set_prolog_flag(singleton_warning,off)) * current_prolog/1 conforms to ISO thanks to strict_iso flag * fix bug (type_list instead of instantiation error for Options) * fix bug setof (not sorted when comes down to findall) Change in GNU Prolog version 0.9.0 (Mar 1999): * add Prolog flag strict_iso (to relax predicate indicators) * fix number_chars and friends non ISO conforming behavior * modify wam2ma to avoid static arrays (use dynamic allocation) * add in-place installation (modify configure.in and Makefile.in) * add copyright headers in source files * rewrite all solutions built-in predicates (in C) * add in-place sorts * rewrite DCG translations * fix compiler bug in wam2ma (atom using \xHH\ not correctly handled) * rewrite sorts built-in predicates (in C) * Calypso (beta 7) becomes GNU Prolog 0.9.0 change command names (calypso -> gprolog, plcc -> gplc,...) copyright messages (--version),... Change in Calypso version 1.0-beta7 (Mar 1999): * fail/0 caused an existence_error under the debugger * user/built_in/built_in_fd not recognized by load/1 * Calypso version 1.0-beta7 ready for internal use ��������������������������gprolog-1.4.5/INSTALL�������������������������������������������������������������������������������0000644�0001750�0001750�00000023410�13021324543�012350� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� INSTALLATION PROCEDURE ---------------------- See file README for a list of currently available ports: The file PROBLEMS contains a list of known problems/limitations depending on the architecure. Please consult it before reporting a problem. Installing the source distribution ********************************** 1) Introduction --------------- ** Win32 preamble ** To compile GNU-Prolog under win32 see file src/WINDOWS. The following tools are required to compile and install the source package: gcc, as, ranlib (if needed), sh, mkdir, cp, rm, sed, test,... The installation process is as follows: cd src go to source directory ./configure [OPTIONS] configure the system make compile locally the package make install or (make install-strip) install the package you can check the result of the local compilation using: make check 2) Installation directories --------------------------- Directories used for the installation are as follows: INSTALL_DIR the root directory for the core package, contains: INSTALL_DIR/bin all binaries (compiler, top-level,...) INSTALL_DIR/lib all libraries and objects INSTALL_DIR/include header files needed to write foreign C code These other directories are optional: LINKS_DIR the directory for links to binaries of INSTALL_DIR/bin DOC_DIR the directory for the documentation (LaTeX, DVI, PostScript,...) HTML_DIR the directory for the HTML documentation EXAMPLES_DIR the directory for the examples, contains: EXAMPLES_DIR/ExamplsPl some classical Prolog examples EXAMPLES_DIR/ExamplesFD some examples using FD constraint solving Default directory values and associated configuration options are as follows: The value of INSTALL_DIR is as follows: - PREFIX/gprolog-VERSION_NUMBER (this is the default) the default value of PREFIX is /usr/local but can be explicitely specified using --prefix=PREFIX - another location can be specified using --with-install-dir=INSTALL_DIR - the source distribution directory (i.e. where reside this INSTALL file) This in-place installation can be specified using --prefix=in-place or --with-install-dir=in-place The value of LINKS_DIR is as follows: - EPREFIX/bin. The value of EPREFIX is the same as PREFIX but can be explicitely specified using --exec-prefix=EPREFIX - another location can be specified --with-links-dir=LINKS_DIR - To prevent the installation of the links use --without-links-dir (this is the default when doing an in-place installation). The default value of DOC_DIR is INSTALL_DIR/doc another location can be specified using --with-doc-dir=DOC_DIR To prevent the installation of documentation --without-doc-dir (this is the default when doing an in-place installation). The default value of HTML_DIR is DOC_DIR/Html another location can be specified using --with-html-dir=HTML_DIR To prevent the installation of the HTML documentation --without-html-dir (this is the default when doing an in-place installation). The default value of EXAMPLES_DIR is INSTALL_DIR another location can be specified using --with-examples-dir=EXAMPLES_DIR To prevent the installation of the examples --without-examples-dir (this is the default when doing an in-place installation). The configure command displays the value of INSTALL_DIR, LINKS_DIR, DOC_DIR, HTML_DIR and EXAMPLES_DIR. To summarize, by default the whole package (+ documentation + HTML + examples) is installed in /usr/local/gprolog-xxx and linked files are installed in /usr/local/bin. 3) Configuration ---------------- GNU Prolog uses autoconf. To configure the package: ./configure [OPTIONS] This script attempts to guess correct values for various system-dependent variables used during compilation. For more detail about autoconf refer to src/AUTOCONF-INFO (try also './configure --help'). The GNU-Prolog specific options are: Options to control the installation directory: --with-install-dir=INSTALL_DIR specify INSTALL_DIR --prefix=PREFIX specify PREFIX (INSTALL_DIR=PREFIX/gprolog-xxx) --prefix=in-place specify an in-place installation Default: --prefix=/usr/local Options to control the location of links to binaries: --with-links-dir=LINKS_DIR specify LINKS_DIR --without-links-dir do not create link to binaries --exec-prefix=EPREFIX specify EPREFIX (LINKS_DIR=EPREFIX/bin) Default: --exec-prefix=PREFIX (links are not installed for an in-place installation). Options to control the location of other components: --with-doc-dir=DOC_DIR specify DOC_DIR --without-doc-dir do not install the documentation --with-html-dir=HTML_DIR specify HTML_DIR --without-thml-dir do not install the HTML documentation --with-examples-dir=EXAMPLES_DIR specify EXAMPLESS_DIR --without-examples-dir do not install the examples Defaults: INSTALL_DIR/doc for DOC_DIR, DOC_DIR/Html for HTML_DIR INSTALL_DIR for EXAMPLES_DIR (these components are not installed for an in-place installation). Options to control C compiler optimization flags: --with-msvc use MSVC++ compiler under Win32 (else use gcc) --without-c-flags do not use any optimization flag --with-c-flags use default C optimization flags --with-c-flags=CFLAGS use CFLAGS (instead of default optimization flags) --with-c-flags=debug use C debug flags (e.g. '-g -Wall' for gcc) Default: --with-c-flags Options to control GNU features to include/exclude: --disable-regs do not use machine registers to optimize speed --enable-ebp use the ebp register on ix86 machines --disable-fast-call do not use fast call mechanism for ix86 processors --disable-linedit do not include line editor facility --disable-piped-consult do not pipe stdin of pl2wam when consult/1 --disable-sockets do not include sockets facility --disable-fd-solver do not include the finite domain constraint solver --disable-gui-console do not use a GUI console (only with MSVC++ or MinGW) --disable-htmlhelp do not use HtmlHelp in the GUI Console --enable-htmlhelp[=static] use HtmlHelp statically linked (default) --enable-htmlhelp=dynamic use HtmlHelp dynamically linked Default: all features are included. Some examples of using configure: To configure the package for an installation in the default directory /usr/local and links to binaries in /usr/local/bin: ./configure To configure the package for an installation in the home directory with linked files in ~/bin/i586 use ./configure --prefix=$HOME --with-links-dir=$HOME/bin/i586 To configure the package for an in-place installation: ./configure --prefix=in-place 4) Compiling the package locally -------------------------------- To locally compile the package: make 5) Installing the package ------------------------- To install the package according to options given to ./configure (see 2): make install You can either install stripped versions of the binaries (whose size is then reduced): make install-strip It is possible to re-run './configure' to change the value of some installation directories (see 2) after the local compilation (i.e. the compilation will not be done again). 6) Cleaning ----------- To remove installed files (remove the content of INSTALL_DIR): make uninstall To clean up the local compilation (does not erase configuration files): make clean To fully clean up the local compilation: make distclean Setting up environment variables ******************************** To be able to execute GNU Prolog from anywhere the directory LINKS_DIR should be a part of your PATH environment variable (generally this directory is already in the PATH variable). However, if no links have been creeated (either --without-links-dir has been specified or in case of default in-place installation) you should add the directory INSTALL_DIR/bin to your PATH variable. This can be done as follows (let us suppose INSTALL_DIR is /usr/local/gprolog-xxx): under sh/bash: PATH=$PATH:/usr/local/gprolog-xxx/bin; export PATH under csh/tcsh: setenv PATH ${PATH}:/usr/local/gprolog-xxx/bin GNU Prolog needs to know the value of INSTALL_DIR (to locate its libraries). To do this, it uses its own path at execution-time, expanding symbolic links. So you should not move or copy the executables, but you can create links to them (as done by the installation procedure in LINKS_DIR). However, to prevent this case, GNU Prolog first consults the value of the PL_PATH environment variable. If it is defined GNU Prolog uses this path. If you want to define it, simply set it to the value of INSTALL_DIR as follows: under sh/bash: PL_PATH=/usr/local/gprolog-xxx; export PL_PATH under csh/tcsh: setenv PL_PATH /usr/local/gprolog-xxx To summarize, by default you can avoid to define PATH and PL_PATH. If you need to defines these variables it is a good idea to put them in your shell start-up file ($HOME/.bashrc / .cshrc / .tcshrc depending on the used shell). Problems ******** See file PROBLEMS for more information on architecture-dependent known problems. If your installation does not work (compilation is ok but when running the system fails) you can try to recompile the whole system with --disable-regs (after make distclean). If this fails, try to recompile the whole system with --with-c-flags=debug and --disable-regs If this installation works with -O and not -O2 (or higher) it can be due to strict-aliasing. Try compiling with --with-c-flags='-O2 -fno-strict-aliasing'. Finally you can use the GNU Prolog mailing lists to ask for help or to report a bug/problem. ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gprolog-1.4.5/PROBLEMS������������������������������������������������������������������������������0000644�0001750�0001750�00000004530�13021324543�012467� 0����������������������������������������������������������������������������������������������������ustar �spa�����������������������������spa��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������If your installation does not work (compilation is ok but when running the system fails) you can try to recompile the whole system with --disable-regs (after make distclean). If this fails, try to recompile the whole system with --with-c-flags=debug and --disable-regs If this installation works with -O and not -O2 (or higher) it can be due to strict-aliasing. Try compiling with --with-c-flags='-O2 -fno-strict-aliasing'. sparc/sunos: under SunOs <= 4.1.2 even if the processor is a supersparc, the gcc option -msupersparc cannot be used in CFLAGS_MACHINE. The configure script omits it. Thus integer multiplication and division is very slow... sparc/solaris: you should be able to access as/ld/ar/ranlib maybe you should add /usr/ucb:/usr/ccs/bin/ ar something similar to your PATH variable ix86/win32 with Cygwin: timmings system_time is always 0 and user time = real time buffering not implemented (after setvbuf each read returns EOF) Linedit does not work if CYGWIN=TTY is defined. ix86/win32 with VC++ 6.0 and MinGW (I suppose): sockets not implemented shell/2 and system/2 do not return correct error code (due to command.com bad interpreted) popen/3 does not work (due to command.com) exec/5 does not work (due to command.com) send_signal/2 (does not work apparently) select/5 only implemented with sockets (to be tested more deeply) ix86/win32 with MinGW cannot be compiled with -fomit-frame-pointer (gcc 3.3.1 and 3.3.3) more precisely fails if engine.c compiled with -O2 -fomit-frame-pointer (and only these 3 functions Execute_Directive Call_Prolog Call_Next suffice to fail with -O2 -fomit-frame-pointer) ppc/linux: with no optimization options for gcc do not use global registers (use: ./configure --with-c-flags=debug --disable-regs) ppc/darwin-macosx: for gcc 3.3 do not use global registers (use: ./configure --disable-regs) ix86/OpenBSD: use gmake instead of make ix86/sco: On SCO UnixWare use --host=i586-pc-sco when using ./configure (until autoconf is updated to recognize UnixWare). MacOS: if a Fatal Error: Segmentation Violation occurs it can be due to a C stack overflow. It is possible to change the size of the C stack before starting GNU Prolog. For instance the following command set the C stack size to 8Mb: ulimit -s 8192 (with bash) limit stacksize 8M (with csh) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������